From a1c6ce6b92b12cfc9231d2b20b2665d3955a393a Mon Sep 17 00:00:00 2001 From: nek0 Date: Tue, 3 Jan 2017 17:34:37 +0100 Subject: [PATCH] works halfway as intended --- src/Commons.hs | 148 +++++++++++++++++++++- src/InGame.hs | 91 +++++++++++++- src/Main.hs | 336 ++++++++++++++++++++++++------------------------- src/Types.hs | 4 +- 4 files changed, 404 insertions(+), 175 deletions(-) diff --git a/src/Commons.hs b/src/Commons.hs index 7040d0b..0a15211 100644 --- a/src/Commons.hs +++ b/src/Commons.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE RecordWildCards #-} + module Commons where import Affection @@ -6,8 +8,10 @@ import GEGL import BABL import qualified Data.Map as M +import Data.List (delete) +import Data.Maybe (catMaybes) -import Control.Monad (foldM) +import Control.Monad (foldM, when) import System.Random (randomRIO) @@ -127,14 +131,14 @@ load _ = do _ <- gegl_node_connect_to hnop "output" hover "aux" _ <- gegl_node_connect_to bg "output" bgover "aux" -- liftIO $ gegl_node_link fgnop fgtranslate - -- _ <- gegl_node_connect_to fgtranslate "output" fgover "aux" + _ <- gegl_node_connect_to fgtranslate "output" fgover "aux" _ <- gegl_node_connect_to fgnop "output" fgover "aux" traceM "nodes complete" myMap <- return $ M.fromList [ (KeyRoot, root) - , (KeyTranslate, translate) - , (KeyRotate, rotate) , (KeyShip, shipNode) + , (KeyShipTranslate, translate) + , (KeyShipRotate, rotate) , (KeyPNop, pnop) , (KeyHNop, hnop) , (KeyCrop, crop) @@ -222,3 +226,139 @@ insertHaskelloid hasks split (px, py) = do , ("rot", tempRot) ] } : hasks + +haskelloidShotDown :: Haskelloid -> Affection UserData () +haskelloidShotDown h = do + ud <- getAffection + -- liftIO $ traceIO $ show $ length $ haskelloids ud + let redHaskelloids = delete h (haskelloids ud) + 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_drop $ hNodeGraph h M.! "root" + 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 + } + +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 $ traceIO $ "moving to: " ++ show nnx ++ " " ++ show nny + 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 + } + +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 + +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 + } + +shotsDraw :: GeglBuffer -> GeglNode -> Particle -> Affection UserData () +shotsDraw _ _ _ = return () + +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 () diff --git a/src/InGame.hs b/src/InGame.hs index e0e86a0..f275b09 100644 --- a/src/InGame.hs +++ b/src/InGame.hs @@ -5,14 +5,103 @@ import qualified SDL import GEGL import qualified Data.Map as M +import Data.Maybe (catMaybes) -import Control.Monad (when) +import Control.Monad (when, foldM) + +import System.Random (randomRIO) import Debug.Trace import Types import Commons +loadGame :: Affection UserData () +loadGame = do + ud <- getAffection + _ <- liftIO $ gegl_node_connect_to + (nodeGraph ud M.! KeyShipTranslate) + "output" + (nodeGraph ud M.! KeyShipOver) + "aux" + hs <- liftIO $ catMaybes <$> foldM (\acc _ -> do + coords <- liftIO excludeShip + insertHaskelloid acc Nothing coords + ) [] ([0..9] :: [Int]) + liftIO $ gegl_node_link_many $ map hFlange hs + liftIO $ gegl_node_link (last $ map hFlange hs) (nodeGraph ud M.! KeyHNop) + putAffection ud + { haskelloids = hs + , wonlost = False + , shots = ParticleSystem + (ParticleStorage Nothing []) + (nodeGraph ud M.! KeyPNop) + (buffer ud) + , ship = Ship + { sPos = (375, 275) + , sVel = (0, 0) + , sRot = 0 + , sFlange = (nodeGraph ud M.! KeyShipRotate) + } + , pixelSize = 3 + , state = InGame + } + +excludeShip :: IO (Double, Double) +excludeShip = do + px <- randomRIO (0, 800) + py <- randomRIO (0, 600) + inter <- gegl_rectangle_intersect + (GeglRectangle px py 100 100) + (GeglRectangle 350 250 100 100) -- Ship's starting position and size + case inter of + Just _ -> + excludeShip + Nothing -> + return (fromIntegral px, fromIntegral py) + +updateGame :: Double -> Affection UserData () +updateGame sec = do + ad <- get + ud <- getAffection + when (((floor $ elapsedTime ad :: Int) * 100) `mod` 10 < 2 && pixelSize ud > 3) $ do + pd <- getAffection + liftIO $ gegl_node_set (nodeGraph pd M.! KeyPixelize) $ Operation "gegl:pixelize" + [ Property "size-x" $ PropertyInt $ pixelSize pd - 1 + , Property "size-y" $ PropertyInt $ pixelSize pd - 1 + ] + putAffection ud + { pixelSize = pixelSize ud -1 + } + let nx = (fst $ sPos $ ship ud) + (fst $ sVel $ ship ud) * sec + ny = (snd $ sPos $ ship ud) + (snd $ sVel $ ship ud) * sec + (nnx, nny) = wrapAround (nx, ny) 50 + liftIO $ gegl_node_set (nodeGraph ud M.! KeyShipTranslate) $ Operation "gegl:translate" + [ Property "x" $ PropertyDouble $ nnx + , Property "y" $ PropertyDouble $ nny + ] + liftIO $ gegl_node_set (nodeGraph ud M.! KeyShipRotate) $ Operation "gegl:rotate" + [ Property "degrees" $ PropertyDouble $ sRot $ ship ud + ] + td <- getAffection + putAffection td + { ship = (ship ud) + { sPos = (nnx, nny) + } + } + ud2 <- getAffection + nhs <- mapM (updateHaskelloid sec) (haskelloids ud2) + putAffection ud2 + { haskelloids = nhs + } + liftIO $ traceIO $ show $ length nhs + ud3 <- getAffection + ups <- updateParticleSystem (shots ud3) sec shotsUpd shotsDraw + ud4 <- getAffection + putAffection ud4 + { shots = ups + } + handleGameEvent :: Double -> SDL.Event -> Affection UserData () handleGameEvent sec e = do ad <- get diff --git a/src/Main.hs b/src/Main.hs index 92189c6..d324c96 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -40,17 +40,17 @@ pre = smLoad Menu update :: Double -> Affection UserData () update sec = do -- traceM $ (show $ 1 / sec) ++ " FPS" - ad <- get + -- 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 - } + -- 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 @@ -66,168 +66,168 @@ update sec = do -- _ -> 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.! KeyTranslate) $ Operation "gegl:translate" - [ Property "x" $ PropertyDouble $ nnx - , Property "y" $ PropertyDouble $ nny - ] - liftIO $ gegl_node_set (nodeGraph ud3 M.! KeyRotate) $ 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 - } + -- 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 +-- 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 () +-- 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 () diff --git a/src/Types.hs b/src/Types.hs index 5dfea8a..46cee94 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -39,9 +39,9 @@ data Haskelloid = Haskelloid data NodeKey = KeyRoot - | KeyTranslate - | KeyRotate | KeyShip + | KeyShipTranslate + | KeyShipRotate | KeyPNop | KeyHNop | KeyCrop