Initial commit

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)