some fixes, some more bugs

src/Main.hs

@@ -51,6 +51,7 @@ load _ = do
   hover <- gegl_node_new_child root $ defaultOverOperation
   pover <- gegl_node_new_child root $ defaultOverOperation
   bgover <- gegl_node_new_child root $ defaultOverOperation
+  fgover <- gegl_node_new_child root $ defaultOverOperation
   translate <- gegl_node_new_child root $ Operation "gegl:translate"
     [ Property "x"        $ PropertyDouble 375
     , Property "y"        $ PropertyDouble 275
@@ -89,7 +90,7 @@ load _ = do
   --   [ Property "pattern" $ PropertyInt 8
   --   ]
   gegl_node_link_many [ship, rotate, translate]
-  gegl_node_link_many [bgover, pover, hover, sover, crop, pixelize, vignette, sink]
+  gegl_node_link_many [bgover, pover, hover, sover, crop, fgover, pixelize, vignette, sink]
   _ <- gegl_node_connect_to translate "output" sover "aux"
   _ <- gegl_node_connect_to pnop "output" pover "aux"
   _ <- gegl_node_connect_to hnop "output" hover "aux"
@@ -108,6 +109,7 @@ load _ = do
     , (KeyWon, won)
     , (KeyLost, lost)
     , (KeyPixelize, pixelize)
+    , (KeyFGOver, fgover)
     ]
   hs <- catMaybes <$> foldM (\acc _ -> do
     px <- liftIO $ randomRIO (0, 800)
@@ -170,23 +172,22 @@ data NodeKey
   | KeyWon
   | KeyLost
   | KeyPixelize
+  | KeyFGOver
   deriving (Ord, Eq)
 
 update :: Double -> Affection UserData ()
 update sec = do
   -- traceM $ (show $ 1 / sec) ++ " FPS"
   ad <- get
-  wd <- getAffection
-  if (not $ wonlost wd)
-  then do
   evs <- SDL.pollEvents
+  wd <- getAffection
   mapM_ (\e ->
     case SDL.eventPayload e of
       SDL.KeyboardEvent dat ->
         case (SDL.keysymKeycode $ SDL.keyboardEventKeysym dat) of
            SDL.KeycodeLeft -> do
              ud <- getAffection
-               when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $
+             when (SDL.keyboardEventKeyMotion dat == SDL.Pressed && not (wonlost wd)) $
                putAffection ud
                  { ship = (ship ud)
                    { sRot = (sRot $ ship ud) + 180 * sec
@@ -201,7 +202,7 @@ update sec = do
                    }
                  }
            SDL.KeycodeUp ->
-               when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $ do
+             when (SDL.keyboardEventKeyMotion dat == SDL.Pressed && not (wonlost wd)) $ do
                ud <- getAffection
                let vx = -10 * (sin (toR $ (sRot $ ship ud))) + fst (sVel $ ship ud)
                    vy = -10 * (cos (toR $ (sRot $ ship ud))) + snd (sVel $ ship ud)
@@ -212,7 +213,7 @@ update sec = do
                  }
                -- traceM $ show (vx, vy) ++ " " ++ show (sRot $ ship ud)
            SDL.KeycodeSpace ->
-               when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $ do
+             when (SDL.keyboardEventKeyMotion dat == SDL.Pressed && not (wonlost wd)) $ do
                ud <- getAffection
                -- ad <- get
                let posX = (fst $ sPos $ ship ud) + 23 - 30 * sin (toR $ sRot $ ship ud)
@@ -285,7 +286,6 @@ update sec = do
       }
     , shots = ups
     }
-  else return ()
 
 wrapAround :: (Ord t, Num t) => (t, t) -> t -> (t, t)
 wrapAround (nx, ny) width = (nnx, nny)
@@ -357,12 +357,8 @@ shotsUpd sec part@Particle{..} = do
       50
       50
       )
-  maybe (return ()) (\_ -> do
+  maybe (return ()) (\_ ->
-    liftIO $ traceIO "YOU LOST!"
+    lose
-    liftIO $ gegl_node_link (nodeGraph ud M.! KeyLost) (nodeGraph ud M.! KeyPixelize)
-    putAffection ud
-      { wonlost = True
-      }
     ) lost
   return part
     { particlePosition = (nnx, nny)
@@ -393,7 +389,11 @@ haskelloidShotDown h = do
       (nodeGraph ud M.! KeyHNop)
   else do
     liftIO $ traceIO "YOU WON!"
-    liftIO $ gegl_node_link (nodeGraph ud M.! KeyWon) (nodeGraph ud M.! KeyPixelize)
+    _ <- liftIO $ gegl_node_connect_to
+      (nodeGraph ud M.! KeyWon)
+      "output"
+      (nodeGraph ud M.! KeyFGOver)
+      "aux"
     putAffection ud
       { wonlost = True
       }
@@ -426,12 +426,8 @@ updateHaskelloid sec h@Haskelloid{..} = do
       50
       50
       )
-  maybe (return ()) (\_ -> do
+  maybe (return ()) (\_ ->
-    liftIO $ traceIO "YOU LOST!"
+    lose
-    liftIO $ gegl_node_link (nodeGraph ud M.! KeyLost) (nodeGraph ud M.! KeyPixelize)
-    putAffection ud
-      { wonlost = True
-      }
     ) lost
   return h
     { hPos = (nnx, nny)
@@ -483,3 +479,17 @@ insertHaskelloid hs split (px, py) = do
       , ("rot", tempRot)
       ]
     } : hs
+
+lose :: Affection UserData ()
+lose = do
+  ud <- getAffection
+  liftIO $ traceIO "YOU LOST!"
+  _ <- liftIO $ gegl_node_connect_to
+    (nodeGraph ud M.! KeyLost)
+    "output"
+    (nodeGraph ud M.! KeyFGOver)
+    "aux"
+  putAffection ud
+    { wonlost = True
+    }
+  liftIO $ gegl_node_drop $ nodeGraph ud M.! KeyShip