Created
January 12, 2015 00:43
-
-
Save doivosevic/57e6c326fcc53c04d648 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
import Control.Monad | |
import Control.Concurrent | |
import System.Random | |
import System.Environment | |
import Data.List | |
import Data.Maybe | |
sec :: Int | |
sec = 1000000 | |
main :: IO() | |
main = do | |
--inp1 <- getLine | |
--inp2 <- getLine | |
args <- getArgs | |
let brOkvira = read $ head args :: Int --read inp1 :: Int | |
let brZahtjeva = read $ args !! 1 :: Int --read inp2 :: Int | |
mv <- newEmptyMVar | |
forkIO (mainThreadWrap mv brZahtjeva brOkvira) | |
forkIO (secondThreadWrap mv brZahtjeva brOkvira) | |
threadDelay $ sec * (brZahtjeva * 2 + 1) | |
return () | |
type Zahtjev = String | |
mainThreadWrap :: MVar Zahtjev -> Int -> Int -> IO() | |
mainThreadWrap mv zahtjeva1 okvira = do | |
zahtjevi <- replicateM zahtjeva1 $ takeMVar mv | |
mainThreadLoop zahtjevi (replicate okvira "") 0 $ 2*zahtjeva1 -- predaju se zahtjevi i broj zahtjeva | |
where | |
mainThreadLoop :: [Zahtjev] -> [Zahtjev] -> Int -> Int -> IO() | |
mainThreadLoop zahtjevi okviri tren zahtjeva = do | |
threadDelay sec | |
new <- tryTakeMVar mv | |
let zahtjevi2 = zahtjevi ++ maybe [] return new | |
putStrLn $ fst $ obradi zahtjevi okviri tren okvira zahtjeva1 -- obradi se predaju zahtjevi i broj okvira | |
unless (zahtjeva == 0) $ uncurry (mainThreadLoop (tail zahtjevi2)) (snd $ obradi zahtjevi okviri tren okvira zahtjeva1) (zahtjeva-1) | |
secondThreadWrap :: MVar Zahtjev -> Int -> Int -> IO() | |
secondThreadWrap mv zahtjeva _ = do | |
replicateM_ zahtjeva nextMVar | |
sequence_ $ take (zahtjeva*2) $ cycle [nextMVar, threadDelay sec] | |
where | |
nextMVar = getStdRandom (randomR (0 :: Int, 9 :: Int)) >>= putMVar mv . show | |
obradi :: [Zahtjev] -> [Zahtjev] -> Int -> Int -> Int -> (String, ([Zahtjev], Int)) | |
obradi zs@(z:_) okviri tren okvira zahtjeva = (retStr, (noviNepodeseni, noviTren)) -- snd arg "okvira" | |
where | |
z' = if z `elem` okviri then "("++z++")" else "["++z++"]" | |
zahts = intercalate "," zs | |
spaces = replicate (2*(zahtjeva - length zs + 2)) ' ' | |
retStr = zahts ++ spaces ++ show z ++ " " ++ intercalate " " noviOkviri | |
noviOkviri = if z `elem` okviri then replaceAt (fromJust $ elemIndex z okviri) okviri z' else replaceAt tren okviri z' | |
noviNepodeseni = if z `elem` okviri then replaceAt (fromJust $ elemIndex z okviri) okviri z else replaceAt tren okviri z | |
noviTren = if z `elem` okviri then tren else (tren+1) `mod` okvira | |
replaceAt :: Int -> [Zahtjev] -> Zahtjev -> [Zahtjev] | |
replaceAt wher what with = fs ++ [with] ++ sn | |
where (fs, _:sn) = splitAt wher what |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment