more beautiful winning and losing

src/Main.hs

@@ -62,6 +62,16 @@ load _ = do
   sink <- gegl_node_new_child root $ Operation "gegl:copy-buffer"
     [ Property "buffer" $ PropertyBuffer buffer
     ]
+  won <- gegl_node_new_child root $ textOperation
+    [ Property "string" $ PropertyString "YOU WON!"
+    , Property "size"   $ PropertyDouble 100
+    , Property "color"  $ PropertyColor $ GEGL.RGBA 1 1 1 1
+    ]
+  lost <- gegl_node_new_child root $ textOperation
+    [ Property "string" $ PropertyString "YOU LOST!"
+    , Property "size"   $ PropertyDouble 100
+    , Property "color"  $ PropertyColor $ GEGL.RGBA 1 1 1 1
+    ]
   gegl_node_link_many [ship, rotate, translate]
   gegl_node_link_many [pover, hover, sover, crop, sink]
   _ <- gegl_node_connect_to translate "output" sover "aux"
@@ -78,6 +88,8 @@ load _ = do
     , (KeyCrop, crop)
     , (KeyShipOver, sover)
     , (KeySink, sink)
+    , (KeyWon, won)
+    , (KeyLost, lost)
     ]
   hs <- catMaybes <$> foldM (\acc _ -> do
     px <- liftIO $ randomRIO (0, 800)
@@ -97,6 +109,7 @@ load _ = do
     , buffer = buffer
     , shots = ParticleSystem (ParticleStorage Nothing []) pnop buffer
     , haskelloids = hs
+    , wonlost = False
     }
 
 data UserData = UserData
@@ -106,6 +119,7 @@ data UserData = UserData
   , haskelloids :: [Haskelloid]
   , shots :: ParticleSystem
   -- , debris :: ParticleSystem
+  , wonlost :: Bool
   }
 
 data Ship = Ship
@@ -135,12 +149,17 @@ data NodeKey
   | KeyCrop
   | KeyShipOver
   | KeySink
+  | KeyWon
+  | KeyLost
   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
     mapM_ (\e ->
       case SDL.eventPayload e of
@@ -247,6 +266,7 @@ update sec = do
         }
       , shots = ups
       }
+  else return ()
 
 wrapAround :: (Ord t, Num t) => (t, t) -> t -> (t, t)
 wrapAround (nx, ny) width = (nnx, nny)
@@ -278,7 +298,7 @@ draw = do
   present
     (GeglRectangle 0 0 800 600)
     (buffer ud)
-    False
+    (not $ wonlost ud)
 
 clean :: UserData -> IO ()
 clean _ = return ()
@@ -319,10 +339,10 @@ shotsUpd sec part@Particle{..} = do
       50
       )
   maybe (return ()) (\_ -> do
-    ad <- get
     liftIO $ traceIO "YOU LOST!"
-    put ad
-      { quitEvent = True
+    liftIO $ gegl_node_link (nodeGraph ud M.! KeyLost) (nodeGraph ud M.! KeySink)
+    putAffection ud
+      { wonlost = True
       }
     ) lost
   return part
@@ -352,10 +372,10 @@ haskelloidShotDown h = do
       (last $ map hFlange newHaskelloids)
       (nodeGraph ud M.! KeyHNop)
   else do
-    ad <- get
     liftIO $ traceIO "YOU WON!"
-    put ad
-      { quitEvent = True
+    liftIO $ gegl_node_link (nodeGraph ud M.! KeyWon) (nodeGraph ud M.! KeySink)
+    putAffection ud
+      { wonlost = True
       }
   putAffection ud
     { haskelloids = newHaskelloids
@@ -387,10 +407,10 @@ updateHaskelloid sec h@Haskelloid{..} = do
       50
       )
   maybe (return ()) (\_ -> do
-    ad <- get
     liftIO $ traceIO "YOU LOST!"
-    put ad
-      { quitEvent = True
+    liftIO $ gegl_node_link (nodeGraph ud M.! KeyLost) (nodeGraph ud M.! KeySink)
+    putAffection ud
+      { wonlost = True
       }
     ) lost
   return h