[continued from previous message]

"PRIVMSG #hr.soc.politika :Bole me prepone, madež na preponi mi se tare o hlače, yay\r\n",
"PRIVMSG #hr.soc.politika :Unošenje u lice i dihanje za ovratnik........\r\n",
"PRIVMSG #hr.soc.politika :Imam 3 male sličice mameka u sobi i u kujini\r\n",
"PRIVMSG #hr.soc.politika :Ima jedna Hrvatica koja živi u Nemačkoj, ona se pali na muški znoj i smrad :-)\r\n",
"PRIVMSG #hr.soc.politika : Da je ponižavam da udiše vonj mošusa sa mojih muda\r\n",
"PRIVMSG #hr.soc.politika :Dajte mi stare, okorele i raspale KURVE!\r\n",
"PRIVMSG #hr.soc.politika :Sad više nemam ništa poderano na sebi!\r\n",
"PRIVMSG #hr.soc.politika :Pojeo sam i par zalogaja sira i vuršta uz krastavac\r\n",
"PRIVMSG #hr.soc.politika :Annie Lennox peva pesmu Doubleplusgood\r\n",
"PRIVMSG #hr.soc.politika :Dvaputvišedobar patkogovoritelj\r\n",
"PRIVMSG #hr.soc.politika :Pod deku nakon žderanja skromnog suhog obroka\r\n",
"PRIVMSG #hr.soc.politika :Svima nam je ntko umro od rodbine u tih 6 godina\r\n",
"PRIVMSG #hr.soc.politika :Čim netko obrati pažnju na bednika zeca ja cvetam :-)\r\n",
"PRIVMSG #hr.soc.politika :U klozetu imam grijalicu na zidu koju je ugradio prijatelj-majstor\r\n",
"PRIVMSG #hr.soc.politika :Još bdijem u kujini slušam muziku i razmišljam a sad sam se vratio u sobu\r\n",
"PRIVMSG #hr.soc.politika :KO oće dame zakolje zato što spavam - nek dođe da me zakolje!!!!\r\n"
]

teranje = ["socna pica","lizi picu","vlazna pica","meka,spremna","pohotna pica","https://pbs.twimg.com/media/EAt9NNwXsAEo_Lz?format=jpg&name=small","https://www.menshealth.rs/stil/9832/higijenska-abeceda-za-svakog-muskarca"]
zvijeri = ["Threadripper 2990WX","Xeon W-3175X"]
jadnici = ["mali","veliki","ekstreman","pomalo"]
response_get tm ref stdgen gsref pl s buf len = do
gen <- readIORef stdgen
str <- peekCStringLen (buf,fromIntegral len)
if str == [] then do
let (val,gen') = randomR (0,(length list_zeka)-1) gen
write pl s $ list_zeka !! val
writeIORef stdgen gen'
t <- getPOSIXTime
writeIORef tm t
return 0
else do
putStrLn $ "got "++str
if isSuffixOf "\r\n" str
then do
b <- readIORef ref
gs <- readIORef gsref
let (res,gen',gs') = parse (b++str) gen gs
putStrLn $ "Writing : "++ res
writeIORef ref []
writeIORef stdgen gen'
writeIORef gsref gs'
write pl s res
else do
b <- readIORef ref
writeIORef ref (b++str)
pl_read pl s
return 0
response_written pl s = do
putStrLn "default done_write"
pl_read pl s
return 0
parse str stdgen gs = foldl parse_line ([],stdgen,gs) $ lines str
where
parse_line (s,stdgen,gs) l =
case words l of
("PING":xs) -> (s++"PONG "++unwords xs++"\r\n",stdgen,gs)
(_:"004":xs) -> (s++"JOIN :#hr.soc.politika\r\n",stdgen,gs)
(_:"433":xs) -> let (s',[gen]) = nick [stdgen] in (s++"NICK "++s'++"\r\n" ,gen,gs)
(who:"PRIVMSG":xs) -> let (str,gen,gs') = response (parse_who who) xs
in (s++str,gen,gs')
(who:"JOIN":xs) -> (s++(if parse_who who /= "zeka_bot" then "PRIVMSG #hr.soc.politika :Hello, " else "PRIVMSG #hr.soc.politika :Hi folks, ")++parse_who who++"\r\n",stdgen,gs)
xs -> case find (=="response") xs of
Nothing -> (s,stdgen,gs)
_ -> (s++"USER zeka_bot 8 * :zeka_bot\r\n",stdgen,gs)
parse_who (w:who) = if w == ':'
then parse_who who
else if w == '!'
then []
else w:parse_who who
response who (channel:cmds) = parse cmds
where
parse ((_:cmd'):cmds) =
case cvt cmd' of
cmd | cmd == "ustaša" || cmd == "budala" || cmd == "ustasa" ||
cmd == "усташа" ||
cmd == "cetnik" || cmd == "četnik" ||
cmd == "четник" ||
cmd == "komunist" || cmd == "комунист" ||
cmd == "peder" || cmd == "pederčina" ||
cmd == "srbin" || cmd == "србин" ||
cmd == "hrvat" || cmd == "хрват" ||
cmd == "crnogorac"|| cmd == "musliman" || cmd == "katolik" ||
cmd == "pravoslavac" || cmd == "židov" || cmd == "zidov" ||
cmd == "invalid" || cmd == "decak" || cmd == "dečak" || cmd == "dječak" ||
cmd == "znanstvenik" || cmd == "naučnik" ||
cmd == "kvir" || cmd == "bednik" || cmd == "jadnik" ->
let (val,gen) =
(case (cmd,who) of
("crnogorac","imandic")-> randomR (90::Int,100) stdgen
("crnogorac","IkaPrisnazitelj")-> randomR (90::Int,100) stdgen
(cmd,"Zdepasti_Zeka") | cmd== "invalid" || cmd == "kvir" || cmd == "katolik" || cmd == "dečak" || cmd == "bednik" || cmd == "budala" -> randomR (80::Int,100) stdgen
(cmd,"Stefan_J") | cmd == "naučnik" || cmd == "znanstvenik" -> randomR (85::Int,100) stdgen
_ -> randomR (0::Int,100) stdgen)
in case cmds of
[] | cmd == "jadnik" ->("PRIVMSG #hr.soc.politika "++":"++ who ++ " ti si "++ jadnici !! (val `mod` (length jadnici)) ++ " jadnik\r\n",gen,gs)
[] | cmd /= "jadnik" -> ("PRIVMSG #hr.soc.politika "++":"++
who++", you are "++show val++"% "++cmd'++"\r\n",gen,gs)
(w:[]) -> ("PRIVMSG #hr.soc.politika "++":"++w++" is "++show val++"% "++cmd'++"\r\n",gen,gs)
_ -> ("",gen,gs)
cmd | cmd == "calc" -> ("PRIVMSG #hr.soc.politika "++":"++(calculate $ unwords cmds) ++ "\r\n",stdgen,gs)
cmd | cmd == "quote" ->
let (val,gen) = randomR(0,(length list_zeka)-1) stdgen
in (list_zeka!!val,gen,gs)
cmd | cmd == "fortune" -> unsafePerformIO $ do
strs <- readProcess "fortune" ["-s","-a"] []
return (sendList $ lines $ strs,stdgen,gs)
cmd | cmd == "teraj" ->
let (val,gen) = randomR(0,(length teranje)-1) stdgen
in (sendList $ [teranje!!val],gen,gs)
cmd | cmd == "zvijer" ->
let (val,gen) = randomR(0,(length zvijeri)-1) stdgen
in (sendList $ [zvijeri!!val],gen,gs)
cmd | cmd == "h" -> case cmds of
[] -> if gameStatus gs /= Guessing
then
let (gs',gen') = newGame stdgen
in (sendList $ displayState gs',gen',gs')
else
(sendList $ displayState gs,stdgen,gs)
cmds -> let (res',gs',gen') = gameLoop gs cmds stdgen
in (sendList res',gen',gs')
_ -> ("",stdgen,gs)

sendList strs = foldl cumul [] strs
where
cumul s str = s++"PRIVMSG #hr.soc.politika :"++str++"\r\n"
cvt str = fmap toLower str
type Operator = Rational -> Rational -> Rational
type Entry = (String, Operator)
type Register = [Entry]

modulu :: Rational -> Rational -> Rational
modulu a b = toRational ((round (fromRational a::Double)) `mod` (round (fromRational b::Double)))

operatorRegister :: Register
operatorRegister = [
("-", (-)),
("+", (+)),
("/", (/)),
("*", (*)),
("%", modulu)
]

--main = print $ calculate "3 * 2 + 5 / 2"

calculate :: String -> String
calculate str = case (eval operatorRegister . words) str of
Just r -> printf "%.2f" (fromRational r::Double)
Nothing -> "Nothing"

eval :: Register -> [String] -> Maybe Rational
eval [] _ = Nothing -- No operator found.
eval _ [] = Nothing -- If a operator don't have anything to operate on.
eval _ [number] = let a :: Maybe Double = readMaybe number
in case a of
Just a -> Just (toRational a)
Nothing -> Nothing
eval ((operator, function):rest) unparsed =
case span (/=operator) unparsed of
(_, []) -> eval rest unparsed
(beforeOperator, afterOperator) ->
function
<$> (eval operatorRegister beforeOperator)
<*> (eval operatorRegister $ drop 1 afterOperator)

wordsPath :: FilePath
wordsPath = "words.txt"-- "/usr/share/dict/words"

data GameState = GameState
{ _wordsToGuess :: [String]
, guesses :: [[String]]
}

data GameStatus = Guessing | GameWon | GameLost deriving Eq

hangmanImages :: [[String]]
hangmanImages =
transpose
[ [ " ", " O ", " O ", " O ", " O " , "_O " , "_O_" ]
, [ " ", " ", " | ", " | ", " | " , " | " , " | " ]
, [ " ", " ", " ", "/ ", "/ \\", "/ \\", "/ \\" ]
]

fullHangmanImage :: Int -> [String]
fullHangmanImage index =
"=========" :
"| |" :
map ("| " ++) img
where img = hangmanImages !! index


maxWrongGuesses :: Int
maxWrongGuesses = length hangmanImages - 1

numberOfWrongGuesses :: GameState -> Int
numberOfWrongGuesses (GameState words' guesses') =
length $ filter (charNotInWord.head.concat) guesses'
where charNotInWord c = c `notElem` concat words'

gameStatus :: GameState -> GameStatus
gameStatus (GameState words' guesses')
| isGuessed = GameWon
| isLastGuess = GameLost
| otherwise = Guessing
where
isGuessed = guesses' /= [] && (all isCharInGuesses (concat words') ||
concat words' == (concat.last) guesses')
isCharInGuesses x = x `elem` map (head.head) guesses'
gameState = GameState words' guesses'
isLastGuess = numberOfWrongGuesses gameState == maxWrongGuesses

displayState :: GameState -> [String]
displayState gameState@(GameState words' guesses') =
fullHangmanImage' ++ case gameStatus gameState of
Guessing ->
[ "Word to guess: " ++ wordWithGuesses
, "Guesses: " ++ (unwords.concat) guesses'
]
GameWon ->
[ "CONGRATULATIONS!"
, "You correctly guessed the word " ++ unwords words'
, " in " ++ show (length guesses') ++ " tries "
]
GameLost ->
[ "YOU FAILED!"
, "You failed to guess the word " ++ unwords words'
]
where
fullHangmanImage' = fullHangmanImage currentHangmanIndex
currentHangmanIndex = numberOfWrongGuesses gameState
wordWithGuesses = blankOrChar <$> unwords words'
blankOrChar c
| c `elem` (map (head.head)) guesses' = c
| c == ' ' = c
| otherwise = '_'


gameLoop :: GameState -> [String]-> StdGen -> ([String],GameState,StdGen) gameLoop gameState words' gen =
let
gameState' = gameState { guesses = guesses gameState ++ [words'] }
res = displayState gameState'
in if gameStatus gameState == Guessing
then (res,gameState',gen)
else
let (gs',gen') = newGame gen
in (displayState gs',gs',gen')

newGame :: StdGen -> (GameState,StdGen)
newGame stdgen = unsafePerformIO $ do
contents <- readFile wordsPath
let words' = map words $ lines contents
(randomNumber,gen) = randomR (0,length words'-1) stdgen
randomWord = words' !! randomNumber
return (GameState randomWord [],gen)

--
7-77-777
\|/
---
/|\

--
Evil Sinner!

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)