{-# LANGUAGE PatternSignatures, FlexibleInstances, TypeSynonymInstances #-}

import IO
import Control.Concurrent
import Control.Concurrent.STM

import List

import MultiSetRewrite.StorePrettyPrinter
import Join.Base
import Join.Join
import Join.JoinPrettyPrinter

import Data.Time
import System.Time

-----------------------------------------------------------------------------------
{-

-- Music started. Make sure that all chairs are vacated
Music(chairs) \ Chair(mypos,seated) | seated == True = Chair(mypos,False)

-- Music is on. Spin players around the chairs still in the game
Music(chairs) \ Player(searched,mypos,x) = do
  { threadDelay 4 -- Walking
  ; if mypos <= chairs then Player(searched,mypos+1,x)
                       else Player(searched,1,x) }

-- Stop music and start chair snatching
StopMusic(n) & Music(chairs) = ChairsSnatching(chairs,n)
                                 
-- This player is the loser (searched all chairs in the game), signal
-- chair snatching complete and player quits the game
ChairsSnatching(chairs,n) & Player(searched,mypos,x) | chairs <= searched = do
  { x .=. True
  ; n .=. True }
        
-- This player found a chair. Mark chair as seated and prepare for next round.
ChairsSnatching(chairs,n) \ Player(searched,mypos,x) & Chair(mypos,seated) | seated == False = do
  { Chair(mypos,True)
  ; Player(1,mypos,x) }
   
-- This player is still looking for a vacant chair
ChairsSnatching(chairs,n) \ Player(searched,mypos,x) = do
  { threadDelay 2 -- Running
  ; if mypos <= chairs then Player(searched+1,pos+1,x)
                       else Player(searched+1,1,x) }

    
musicalChairs 0 = return ()
musicalChairs chairs = do
  { Music(chairs)
    -- Music playing
  ; threadDelay 50 
  ; x <- newSync
  ; StopMusic(x)
  ; waitSync x     
    -- round resolved
  ; musicalChairs (chairs-1) }
                 
-}
     
-----------------------------------------------------------------------------------

music chairs = method "Music" chairs
chair mypos seated = method "Chair" (mypos,seated)
player searched mypos x = method "Player" (searched,mypos,x)
stopMusic n = method "StopMusic" n
chairsSnatching chairs n = method "ChairsSnatching" (chairs,n)

call_music join chairs = call join "Music" chairs
call_chair join mypos seated = call join "Chair" (mypos,seated)
call_player join searched mypos x = call join "Player" (searched,mypos,x)
call_stopMusic join n = call join "StopMusic" n
call_chairsSnatching join chairs n = call join "ChairsSnatching" (chairs,n)         

musicalChairRules join activeMethod = do
  { chairs   <- newVar :: IO (VAR Int)
  ; searched <- newVar :: IO (VAR Int) 
  ; mypos    <- newVar :: IO (VAR Int)
  ; x        <- newVar :: IO (VAR (Sync Bool))
  ; n        <- newVar :: IO (VAR (Sync Bool))
  ; seated   <- newVar :: IO (VAR Bool)
  ; let prog =
          translateJoinDefinitions
          [ 
            ([music chairs] .\. [chair mypos seated]) 
                `when` (do { v_seated <- readVar seated
                           ; return $ v_seated == True }) 
                 .->. do { v_mypos <- readVar mypos
                         ; call_chair join v_mypos False 
                         } -- ; putStr "1" }

          , ([music chairs] .\. [player searched mypos x]) .->. do
                { threadDelay 4 -- Walking
                ; v_mypos  <- readVar mypos
                ; v_chairs <- readVar chairs
                ; let newpos = if v_mypos <= v_chairs 
                               then v_mypos + 1
                               else 1 
                ; v_searched <- readVar searched
                ; v_x <- readVar x
                ; call_player join v_searched newpos v_x 
                } -- ; putStr "2" }
                
          , [stopMusic n,music chairs] .->. do
                { v_chairs <- readVar chairs
                ; v_n      <- readVar n
                ; call_chairsSnatching join v_chairs v_n
                } -- ; putStr "3" }
      
          , [chairsSnatching chairs n, player searched mypos x] 
                `when` (do { v_chairs   <- readVar chairs
                           ; v_searched <- readVar searched
                           ; return $ v_chairs <= v_searched }) 
                .->. do { x .=. True
                        ; n .=. True 
                        } -- ; putStr "4" }
        
          , ([chairsSnatching chairs n] .\. [player searched mypos x, chair mypos seated]) 
                `when` (do { v_seated <- readVar seated 
                           ; return $ v_seated == False }) 
                .->. do { v_mypos <- readVar mypos
                        ; v_x     <- readVar x
                        ; call_chair join v_mypos True
                        ; call_player join (1 :: Int) v_mypos v_x
                        } -- ; putStr "5" }

          , ([chairsSnatching chairs n] .\. [player searched mypos x]) .->. do
                { threadDelay 2 -- Running
                ; v_mypos  <- readVar mypos
                ; v_chairs <- readVar chairs
                ; let newpos = if v_mypos <= v_chairs 
                               then v_mypos + 1
                               else 1
                ; v_searched <- readVar searched
                ; v_x        <- readVar x
                ; call_player join (v_searched+1) newpos v_x
                } -- ; putStr "6" }                              
          ]   
          
  ; res <- runJoinOnGoal (store join) activeMethod prog
  ; case res of
      Just action -> action
      Nothing     -> return () } 
      
      
musicalChairs _ 0 = return ()
musicalChairs join chairs = do
  { call_music join chairs 
    -- Music playing
  ; threadDelay 50 
  ; x <- newSync :: IO (Sync Bool)
  ; call_stopMusic join x
  ; waitSync x     
    -- round resolved
  ; musicalChairs join (chairs-1) }
  
-----------------------------------
-- Test --
-----------------------------------

main = test1

initChairs :: Int
initChairs = 30

test1 = do 
  { jStore <- newJoinStore
  ; let join = Join {store = jStore, rules = musicalChairRules}
  
  ; t1 <- getCurrentTime

  ; tids <- mapM (\v -> forkIO $ do { x <- newSync :: IO (Sync Bool)
                                    ; call_player join (1 :: Int) v x 
                                    ; waitSync x
                                    ; return () }) [1..initChairs+1]

  ; mapM_ (\v -> forkIO $ do { call_chair join v False
                             ; return () }) [1..initChairs]

  ; musicalChairs join initChairs
  
  ; t2 <- getCurrentTime
  
  ; mapM_ (\tid -> killThread tid) tids
  
  ; s <- prettyIt $ store join
  ; putStrLn s
  
  ; let diff = diffUTCTime t2 t1
  ; putStrLn $ "\nTime Taken (Sec):\n" ++ (show diff) }