module Language.Nomyx.Examples(nothing, helloWorld, accounts, createBankAccount, winXEcuPerDay,
winXEcuOnRuleAccepted, moneyTransfer, delRule, voteWithMajority, king, makeKing, monarchy,
revolution, victoryXRules, victoryXEcu, displayTime, noGroupVictory, iWin, returnToDemocracy,
banPlayer, referendum, referendumOnKickPlayer, gameMasterElections, gameMaster,
module Data.Time.Recurrence, module Control.Monad, module Data.List, module Data.Time.Clock) where
import Language.Nomyx.Definition
import Language.Nomyx.Rule
import Language.Nomyx.Expression
import Data.Function
import Data.Time.Clock hiding (getCurrentTime)
import Data.Time.Recurrence hiding (filter)
import Control.Arrow
import Data.List
import Control.Monad
import Language.Nomyx.Vote
(elections, referendum, assessOnTimeDelay, assessOnEveryVote, withQuorum, majority, voteWith_)
import Language.Nomyx.Utils (oneDay)
nothing :: RuleFunc
nothing = return Void
helloWorld :: RuleFunc
helloWorld = voidRule $ outputAll "hello, world!"
accounts :: V [(PlayerNumber, Int)]
accounts = V "Accounts"
createBankAccount :: RuleFunc
createBankAccount = voidRule $ createValueForEachPlayer_ accounts
winXEcuPerDay :: Int -> RuleFunc
winXEcuPerDay x = voidRule $ schedule_ (recur daily) $ modifyAllValues accounts (+x)
winXEcuOnRuleAccepted :: Int -> RuleFunc
winXEcuOnRuleAccepted x = voidRule $ onEvent_ (RuleEv Activated) $ \(RuleData rule) -> modifyValueOfPlayer (_rProposedBy rule) accounts (+x)
moneyTransfer :: RuleFunc
moneyTransfer = voidRule $ do
pls <- getAllPlayerNumbers
when (length pls >= 2) $ forEachPlayer_ (selPlayer pls) where
selPlayer pls src = onInputChoice_ "Transfer money to player: " (delete src $ sort pls) (selAmount src) src
selAmount src dst = onInputStringOnce_ ("Select Amount to transfert to player: " ++ show dst) (transfer src dst) src
transfer src dst amount = do
modifyValueOfPlayer dst accounts (\a -> a + (read amount))
modifyValueOfPlayer src accounts (\a -> a (read amount))
output ("You gave " ++ amount ++ " to " ++ show dst) src
output (show src ++ " gaved you " ++ amount ++ " Ecus") dst
delRule :: RuleNumber -> RuleFunc
delRule rn = voidRule $ suppressRule rn >> autoDelete
makeKing :: PlayerNumber -> RuleFunc
makeKing pn = voidRule $ do
voidRule $ newVar_ "King" pn
modifyPlayerName pn ("King " ++)
king :: V PlayerNumber
king = V "King"
monarchy :: RuleFunc
monarchy = voidRule $ onEvent_ (RuleEv Proposed) $ \(RuleData rule) -> do
k <- readVar_ king
onInputChoiceEnumOnce_ ("Your Royal Highness, do you accept rule " ++ (show $ _rNumber rule) ++ "?") True (activateOrReject rule) k
revolution :: PlayerNumber -> RuleFunc
revolution player = voidRule $ do
suppressRule 1
makeKing player
rNum <- addRuleParams "Monarchy" monarchy "monarchy" "Monarchy: only the king can vote on new rules"
activateRule_ rNum
--autoDelete
victoryXRules :: Int -> RuleFunc
victoryXRules x = voidRule $ onEvent_ (RuleEv Activated) $ \_ -> do
rs <- getActiveRules
let counts = map (_rProposedBy . head &&& length) $ groupBy ((==) `on` _rProposedBy) rs
let victorious = map fst $ filter ((>= x) . snd) counts
when (length victorious /= 0) $ setVictory victorious
victoryXEcu :: Int -> RuleFunc
victoryXEcu x = voidRule $ onEvent_ (RuleEv Activated) $ \_ -> do
as <- readVar_ accounts
let victorious = map fst $ filter ((>= x) . snd) as
if (length victorious /= 0) then setVictory victorious else return ()
displayTime :: RuleFunc
displayTime = voidRule $ do
t <- getCurrentTime
onEventOnce_ (Time $ addUTCTime 5 t) $ \(TimeData t) -> outputAll $ show t
noGroupVictory :: RuleFunc
noGroupVictory = voidRule $ onEvent_ Victory $ \(VictoryData ps) -> when (length ps >1) $ setVictory []
iWin :: RuleFunc
iWin = voidRule $ getSelfProposedByPlayer >>= giveVictory
voteWithMajority :: RuleFunc
voteWithMajority = onRuleProposed $ voteWith_ (majority `withQuorum` 2) $ assessOnEveryVote >> assessOnTimeDelay oneDay
returnToDemocracy :: [RuleNumber] -> RuleFunc
returnToDemocracy rs = voidRule $ do
mapM_ suppressRule rs
rNum <- addRuleParams "vote with majority" voteWithMajority "voteWithMajority" "majority with a quorum of 2"
activateRule_ rNum
autoDelete
banPlayer :: PlayerNumber -> RuleFunc
banPlayer pn = voidRule $ do
delPlayer pn
onEvent_ (Player Arrive) $ \(PlayerData _) -> void $ delPlayer pn
referendumOnKickPlayer :: RuleFunc
referendumOnKickPlayer = referendum " kick player 2" (void $ delPlayer 2)
gameMasterElections :: RuleFunc
gameMasterElections = voidRule $ do
pls <- getPlayers
elections "Game Master" pls makeGM
makeGM :: PlayerNumber -> Nomex()
makeGM pn = do
newVar "GameMaster" pn
void $ modifyPlayerName pn ("GameMaster " ++)
gameMaster :: V PlayerNumber
gameMaster = V "GameMaster"