module Manatee.Extension.IrcClient.Smile where
import Control.Arrow
import Control.Monad
import Data.Array
import Data.ByteString (ByteString)
import Data.Map (Map)
import Graphics.UI.Gtk hiding (Statusbar, statusbarNew, get, Language)
import Manatee.Toolkit.General.String
import Manatee.Toolkit.General.Map
import Manatee.Toolkit.General.Maybe
import Paths_manatee_ircclient
import System.FilePath
import Text.Regex.Posix hiding (after)
import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.Map as M
smileSize :: Int
smileSize = 16
smileMessage :: ByteString -> Map String Pixbuf -> IO (ByteString, [(Int, Pixbuf)])
smileMessage msg pixbufMap = do
let
msgString = UTF8.toString msg
stringMatches =
filter (\ (word, _) -> not $ isBlankString word)
$ map (\x ->
let (_ : (word, (matchOffset, matchLength)) : _) = elems x
in (word, (matchOffset, matchLength)))
(matchAllText
(makeRegex ("\\s(x\\(|;\\)|:/|:'|:>|:x|:\\*|:z|:\\(|:D|:\\)|:o|:I|;p|:O|)" :: String) :: Regex)
msgString)
smilePixbuf str =
let (_, pixbuf) = maybeError
(findMinMatch pixbufMap (\ name _ -> name == str))
("smileMessage : can't match smile " ++ str)
in pixbuf
getInsertOffset [] _ _ = []
getInsertOffset [(_, (offset, _))] deleteLen pixbufNum =
[offset deleteLen + pixbufNum]
getInsertOffset ((_, (offset, length)) : xs) deleteLen pixbufNum =
(offset deleteLen + pixbufNum) : getInsertOffset xs (deleteLen + length) (pixbufNum + 1)
getNewMessage [] _ _ = ""
getNewMessage [(_, (matchOffset, matchLen))] str deleteOffset =
let (fstStr, sndStr) = splitAt (matchOffset deleteOffset) str
(_, restStr) = splitAt matchLen sndStr
in fstStr ++ restStr
getNewMessage ((_, (matchOffset, matchLen)) : xs) str deleteOffset =
let (fstStr, sndStr) = splitAt (matchOffset deleteOffset) str
(_, restStr) = splitAt matchLen sndStr
in fstStr ++ getNewMessage xs restStr (matchOffset + matchLen)
if null stringMatches
then return (msg, [])
else do
let pixbufs = map (\ (str, _) -> smilePixbuf str) stringMatches
offsets = getInsertOffset stringMatches 0 0
newMessage = UTF8.fromString $ getNewMessage stringMatches msgString 0
return (newMessage, zip offsets pixbufs)
createSmilePixbufs :: IO (Map String Pixbuf)
createSmilePixbufs = do
dir <- getDataDir
let imagePath imageName = dir </> (imageName ++ ".png")
paths = map (second imagePath)
[("x(", "angry")
,(":/", "confused")
,(":'", "crying")
,(":>", "embarrassed")
,(":x", "inlove")
,(":*", "kiss")
,(":z", "sleepy")
,(":(", "sad")
,(":D", "laugh")
,(":)", "smile")
,(":o", "surprised")
,(":I", "tired")
,(";p", "tongue")
,(":O", "whistling")
,(";)", "wink")]
pixbufs <-
forM paths $ \ (smileStr, path) -> do
pixbuf <- pixbufNewFromFileAtScale path smileSize smileSize True
return (smileStr, pixbuf)
return $ M.fromList pixbufs