diff options
Diffstat (limited to '')
| -rw-r--r-- | Hsbot/Plugin/Duck.hs | 39 | ||||
| -rw-r--r-- | hsbot.cabal | 3 |
2 files changed, 33 insertions, 9 deletions
diff --git a/Hsbot/Plugin/Duck.hs b/Hsbot/Plugin/Duck.hs index 7e8c521..4a09d28 100644 --- a/Hsbot/Plugin/Duck.hs +++ b/Hsbot/Plugin/Duck.hs @@ -4,26 +4,32 @@ module Hsbot.Plugin.Duck , theDuck ) where -import Control.Concurrent.Chan () +import Control.Concurrent import qualified Data.List as L import Control.Monad.Reader import qualified Network.IRC as IRC import Prelude hiding (catch) +import System.Random import Hsbot.Message import Hsbot.Types +import Hsbot.Utils -- | The duck plugin identity duck :: PluginId duck = PluginId { pluginName = "duck" - , pluginEp = theDuck } + , pluginEp = theDuck "" 11 } -- | An IRC plugin that generates and kills ducks -theDuck :: Plugin (Env IO) () -theDuck = forever $ do - msg <- readMsg - eval msg +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 where eval :: Message -> Plugin (Env IO) () eval (IncomingMsg msg) @@ -31,17 +37,34 @@ theDuck = forever $ do | otherwise = 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) + -- | 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 +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] + -- | There are many ways to hide as a duck, this function tries to cover most of them ducks :: [String] ducks = [ x : y : z | x <- nose, y <- face, z <- ["__/", "_/", "/"] ] ++ [ L.reverse $ x : y : z | x <- nose, y <- face, z <- ["__\\", "_\\", "\\"] ] where - nose :: [Char] + nose :: String nose = "<>=" - face :: [Char] + face :: String face = "oO°@©®ð*òôóø" diff --git a/hsbot.cabal b/hsbot.cabal index e60d115..ecbffe1 100644 --- a/hsbot.cabal +++ b/hsbot.cabal @@ -1,5 +1,5 @@ Name: hsbot -Version: 0.4.9 +Version: 0.4.10 Cabal-version: >=1.2 Synopsis: A multipurposes IRC bot Description: @@ -39,6 +39,7 @@ Library irc, mtl, network, + random, tls >= 0.6.1, tls-extra >= 0.2.0 |