From a6ac073a6c5887fccbd75cb3a24e0b9cfd072cf0 Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Wed, 11 May 2011 00:29:19 +0200
Subject: Re-engineered and finished the duck spawning capability.

---
 Hsbot/Plugin/Duck.hs | 84 +++++++++++++++++++++++++++++++++++-----------------
 1 file changed, 57 insertions(+), 27 deletions(-)

(limited to 'Hsbot')

diff --git a/Hsbot/Plugin/Duck.hs b/Hsbot/Plugin/Duck.hs
index 4a09d28..afc9fa3 100644
--- a/Hsbot/Plugin/Duck.hs
+++ b/Hsbot/Plugin/Duck.hs
@@ -19,44 +19,70 @@ import Hsbot.Utils
 duck :: PluginId
 duck = PluginId
     { pluginName = "duck"
-    , pluginEp   = theDuck "" 11 }
+    , pluginEp   = theDuck "" 10 }
 
 -- | An IRC plugin that generates and kills ducks
 theDuck :: String -> Int -> Plugin (Env IO) ()
 theDuck channel seconds = do
-    env <- lift ask
-    pEnv <- ask
-    secondsMVar <- liftIO $ newMVar seconds
-    killMVar <- liftIO newEmptyMVar
-    (liftIO . forkIO $ runReaderT (runReaderT (duckSpawner channel secondsMVar killMVar) pEnv) env) >>= lift . addThreadIdToQuitMVar
-    forever $ readMsg >>= eval
+    ducksMVar <- liftIO newEmptyMVar
+    duckSpawner channel seconds ducksMVar
+    forever $ readMsg >>= eval ducksMVar
   where
-    eval :: Message -> Plugin (Env IO) ()
-    eval (IncomingMsg msg)
-        | IRC.msg_command msg == "PRIVMSG" = answerMsg msg . isThereADuckToKillInThere . concat $ IRC.msg_params msg
+    eval :: MVar Int -> Message -> Plugin (Env IO) ()
+    eval ducksMVar (IncomingMsg msg)
+        | IRC.msg_command msg == "PRIVMSG" = do
+            -- First we kill the ducks that we find in the message
+            let kills = howManyDucksInThere . concat $ IRC.msg_params msg
+            when (kills /= "") $ answerMsg msg kills
+            -- Then we check if someone shot some duck
+            let shots = howManyBulletFiredInThere . concat $ IRC.msg_params msg
+            noDucksToShot <- liftIO $ isEmptyMVar ducksMVar
+            when (and [getDestination msg == channel, not noDucksToShot, shots > 0]) $ do
+                -- TODO: score dead ducks (with a min (ducksWaitingForDeath, shots))
+                ducksWaitingForDeath <- liftIO $ modifyMVar ducksMVar (\x -> return (x - shots, x))
+                when (shots >= ducksWaitingForDeath) $ do
+                    _ <- liftIO $ takeMVar ducksMVar
+                    duckSpawner channel seconds ducksMVar
+                    -- TODO : score lost bullets and round
+                    return ()
+            -- Finally we check if we received some command
+            cmdArgs <- lift $ getCommand msg
+            case cmdArgs of
+                --"ducks":"stats":args -> TODO
+                "ducks":_ -> answerMsg msg "Invalid duck command."
+                _ -> return ()
         | otherwise = return ()
-    eval _ = return ()
+    eval _ _ = return ()
 
 -- | Regularly spawns ducks on a channel, just waiting to be shot
-duckSpawner :: String -> MVar Int -> MVar Int -> Plugin (Env IO) ()
-duckSpawner channel secondsMVar killMVar = forever $ do
-    nbDucks <- liftIO . getStdRandom $ randomR (1,4)
-    liftIO $ putMVar killMVar nbDucks
-    thoseDucks <- liftIO $ someRandomDucks nbDucks ""
-    writeMsg . OutgoingMsg $ IRC.Message Nothing "PRIVMSG" [channel, thoseDucks]
-    secs <- liftIO $ readMVar secondsMVar
-    liftIO $ threadDelay (3000000 * secs)
+duckSpawner :: String -> Int -> MVar Int -> Plugin (Env IO) ()
+duckSpawner channel secs ducksMVar = do
+    pEnv <- ask
+    lift ask >>= liftIO . forkIO . runReaderT (runReaderT trueSpawner pEnv) >>= lift . addThreadIdToQuitMVar
+  where
+    trueSpawner :: Plugin (Env IO) ()
+    trueSpawner = do
+        rsecs <- liftIO . getStdRandom $ randomR (1,secs)
+        liftIO $ threadDelay (1000000 * rsecs)
+        nbDucks <- liftIO . getStdRandom $ randomR (1,4)
+        thoseDucks <- liftIO $ replicateM nbDucks someRandomDuck
+        liftIO $ putMVar ducksMVar nbDucks
+        writeMsg . OutgoingMsg $ IRC.Message Nothing "PRIVMSG" [channel, concat thoseDucks]
+        liftIO myThreadId >>= lift . delThreadIdFromQuitMVar
 
 -- | Shoot as many times are there are ducks in the initial string
-isThereADuckToKillInThere :: String -> String
-isThereADuckToKillInThere = concat . concatMap (\y -> map (\x -> if x `L.isInfixOf` y then "PAN! " else "") ducks) . words
+howManyBulletFiredInThere :: String -> Int
+howManyBulletFiredInThere = sum . concatMap (\y -> map (\x -> if x `L.isInfixOf` y then 1 else 0) bangs) . words
 
-someRandomDucks :: Int -> String -> IO String
-someRandomDucks 0 theDucks = return theDucks
-someRandomDucks nbDucks theDucks = do
-    whatDuck <- getStdRandom $ randomR (1,length ducks)
-    let thisDuck = ducks !! whatDuck
-    someRandomDucks (nbDucks -1 ) $ concat [thisDuck, " ", theDucks]
+-- | Shoot as many times are there are ducks in the initial string
+howManyDucksInThere :: String -> String
+howManyDucksInThere = concat . concatMap (\y -> map (\x -> if x `L.isInfixOf` y then "PAN! " else "") ducks) . words
+
+-- | Output a string made of the specified number of random ducks
+someRandomDuck :: IO String
+someRandomDuck = do
+    whatDuck <- getStdRandom $ randomR (0,length ducks - 1)
+    return $ ducks !! whatDuck ++ "    "
 
 -- | There are many ways to hide as a duck, this function tries to cover most of them
 ducks :: [String]
@@ -68,3 +94,7 @@ ducks = [ x : y : z | x <- nose, y <- face, z <- ["__/", "_/", "/"] ]
     face :: String
     face = "oO°@©®ð*òôóø"
 
+-- | Weapons can have different noises
+bangs :: [String]
+bangs = [ "PAN", "PAN!" ]
+
-- 
cgit v1.2.3