diff options
Diffstat (limited to 'miaowe.hs')
| -rw-r--r-- | miaowe.hs | 198 |
1 files changed, 198 insertions, 0 deletions
diff --git a/miaowe.hs b/miaowe.hs new file mode 100644 index 0000000..24d7506 --- /dev/null +++ b/miaowe.hs @@ -0,0 +1,198 @@ +-- IRC art (spam)bot + +import Data.Bits +import qualified Data.ByteString as S +import qualified Data.ByteString.Char8 as S.Char8 +import qualified Data.ByteString.Internal as S.Internal +import Data.List +import Data.Word +import System.Directory +import System.Environment +import System.Exit +import System.IO +import Text.Printf + +--import Debug.Trace + +type BitMap = [Word8] +type MircString = String + +type PpmBmp = [Word8] + +type IrcChannel = String + +data Image = Image { + imgBmp :: BitMap, + imgPitch :: Int, + imgHeight :: Int + } + +ctrlC = [toEnum 03] :: String +ctrlO = [toEnum 15] :: String +ctrlV = [toEnum 22] :: String + +-- https://www.mirc.com/colors.html +w24ToMirc :: BitMap -> MircString +w24ToMirc word + -- White + | (word!!0 > 210) && (word!!1 > 210) && (word!!2 > 210) + = "0" + -- Black + | (word!!0 == 0) && (word!!1 == 0) && (word!!2 == 0) + = "1" + -- Light red + | (word!!0 > 127) && (word!!1 == 0) && (word!!2 == 0) + = "4" + -- Light green + | (word!!0 == 0) && (word!!1 > 147) && (word!!2 == 0) + = "9" + -- Light blue + | (word!!0 == 0) && (word!!1 == 0) && (word!!2 > 127) + = "12" + -- Red (aka brown) + | (word!!0 <= 127) && (word!!1 == 0) && (word!!2 == 0) + = "5" + -- Green + | (word!!0 == 0) && (word!!1 <= 147) && (word!!2 == 0) + = "3" + -- Blue + | (word!!0 == 0) && (word!!1 == 0) && (word!!2 <= 127) + = "2" + -- Yellow + | (word!!0 > 252) && (word!!1 > 127) && (word!!2 == 0) + = "8" + -- Orange + | (word!!0 <= 252) && (word!!1 <= 127) && (word!!2 == 0) + = "7" + -- Pink + | (word!!0 > 156) && (word!!1 == 0) && (word!!2 > 156) + = "13" + -- Purple + | (word!!0 <= 156) && (word!!1 == 0) && (word!!2 <= 156) + = "6" + -- Light cyan + | (word!!0 == 0) && (word!!1 > 147) && (word!!2 > 147) + = "11" + -- Cyan + | (word!!0 == 0) && (word!!1 <= 147) && (word!!2 <= 147) + = "10" + -- Light grey + | (word!!0 > 127) && (word!!1 > 127) && (word!!2 > 127) + = "15" + -- Grey + | otherwise = "14" + +lineToMirc :: BitMap -> MircString +lineToMirc [] = [] +lineToMirc line = ctrlC ++ w24ToMirc (take 3 line) ++ ctrlV ++ " " ++ ctrlO + ++ lineToMirc (drop 3 line) + +bmpToMirc :: Int -> Int -> BitMap -> MircString +bmpToMirc _ 0 _ = [] +bmpToMirc pitch height bmp =lineToMirc (take pitch bmp) ++ "\n" + ++ bmpToMirc pitch (height-1) (drop pitch bmp) + +w8Split :: Word8 -> [Word8] -> [[Word8]] +w8Split c = map S.unpack . S.split c . S.pack + +w8ToString :: [Word8] -> String +w8ToString = S.Char8.unpack . S.pack + +ppmToImage :: PpmBmp -> Image +ppmToImage ppm = Image + (intercalate [S.Internal.c2w '\n'] $ drop 3 + (w8Split (S.Internal.c2w '\n') ppm)) + ((read (w8ToString + ((w8Split (S.Internal.c2w ' ') ((w8Split + (S.Internal.c2w '\n') ppm) !! 1)) !! 0)))*3) + (read ( w8ToString + ((w8Split (S.Internal.c2w ' ') ((w8Split + (S.Internal.c2w '\n') ppm) !! 1)) !! 1))) + +ircConnect :: String -> MircString +ircConnect credentials = printf "NICK miaowe\r\n\ + \USER nya 0 * :mew mew\r\n\ + \PRIVMSG NickServ :IDENTIFY %s\r\n" credentials + +waitForMessage :: (String -> Bool) -> IO String +waitForMessage p = getLine >>= \l -> if p l + then return l + else + (if (words l)!!0 == "PING" + then + putStr + ("PONG " ++ ((words l)!!1) ++ "\r\n") + >> hFlush stdout + else return ()) + >> waitForMessage p + +waitForCloak :: IO String +waitForCloak = waitForMessage (\l -> (words l)!!1 == "396") + +waitForCommand :: IO String +waitForCommand = waitForMessage (\l -> if ((length (words l)) >= 4) + then ((words l)!!3 == ":miaowe:") + else False) + +joinChannel :: String -> IO () +joinChannel c = putStr (printf "JOIN %s\r\n" c) + +sendToChannel :: IrcChannel -> MircString -> IO () +sendToChannel c s = (putStr $ concat $ map (\l -> printf "PRIVMSG %s :%s\r\n" c l) + (lines s)) >> hFlush stdout + +sendFile :: IrcChannel -> FilePath -> IO () +sendFile channel path = S.readFile path + >>= sendToChannel channel . + (\img ->bmpToMirc + (imgPitch img) + (imgHeight img) + (imgBmp img)) . + ppmToImage . + S.unpack . + S.Char8.pack . + intercalate "\n" . + filter (\l->not (head l == '#')) . + lines . + S.Char8.unpack + +trySendFile :: IrcChannel -> FilePath -> IO () +trySendFile channel path = (doesFileExist (path) + >>= (\b -> + if b + then + sendFile channel (path) + else + sendToChannel channel "No such file." + >> hFlush stdout)) + +processCommand :: IrcChannel -> MircString -> IO () +processCommand channel command | (words command)!!4 == "Quit" = exitSuccess + | otherwise = (if isInfixOf "/" ((words command)!!4) + then + sendToChannel channel + "Only PWD please." + else + trySendFile channel + ((words command)!!4)) + +mainLoop :: IrcChannel -> IO () +mainLoop channel = waitForCommand + >>= \line -> + processCommand channel line + >> mainLoop channel + + +main :: IO () +main = + openFile "conf" ReadMode + >>= hGetLine + >>= putStr . ircConnect + >> hFlush stdout + >> waitForCloak + >> hFlush stdout + >> getArgs + >>= \args -> + joinChannel (args!!0) + >> hFlush stdout + >> mainLoop (args!!0) |