module Language.Nomyx.Examples(
nothing,
helloWorld,
accounts,
createBankAccount,
winXEcuPerDay,
winXEcuOnRuleAccepted,
moneyTransfer,
delRule,
voteWithMajority,
king,
makeKing,
monarchy,
revolution,
displayTime,
iWin,
returnToDemocracy,
victoryXRules,
victoryXEcu,
--noGroupVictory,
banPlayer,
referendum,
referendumOnKickPlayer,
gameMasterElections,
gameMaster,
bravoButton,
enterHaiku,
displayBankAccount,
module X) where
import Data.Function
import Data.Time.Clock as X hiding (getCurrentTime)
import Data.Time.Recurrence as X hiding (filter)
import Data.List as X
import Data.Typeable
import Control.Arrow
import Control.Monad as X
import Safe (readDef)
import Language.Nomyx
nothing :: Rule
nothing = return ()
helloWorld :: Rule
helloWorld = outputAll_ "hello, world!"
accounts :: MsgVar [(PlayerNumber, Int)]
accounts = msgVar "Accounts"
createBankAccount :: Rule
createBankAccount = void $ createValueForEachPlayer_ accounts
displayBankAccount :: Rule
displayBankAccount = do
let displayOneAccount (account_pn, a) = do
name <- showPlayer account_pn
return $ name ++ "\t" ++ show a ++ "\n"
let displayAccounts l = do
d <- concatMapM displayOneAccount l
return $ "Accounts:\n" ++ d
void $ displayVar' Nothing accounts displayAccounts
winXEcuPerDay :: Int -> Rule
winXEcuPerDay x = schedule_ (recur daily) $ modifyAllValues accounts (+x)
winXEcuOnRuleAccepted :: Int -> Rule
winXEcuOnRuleAccepted x = void $ onEvent_ (ruleEvent Activated) $ \rule -> void $ modifyValueOfPlayer (_rProposedBy rule) accounts (+x)
moneyTransfer :: Rule
moneyTransfer = do
pls <- liftEffect getAllPlayerNumbers
when (length pls >= 2) $ void $ forEachPlayer_ (selPlayer pls) where
selPlayer pls src = void $ onInputRadio_ "Transfer money to player: " (delete src $ sort pls) (selAmount src) src
selAmount src dst = void $ onInputTextOnce ("Select Amount to transfert to player: " ++ show dst) (transfer src dst) src
transfer src dst amount = do
modifyValueOfPlayer dst accounts (\a -> a + (readDef 0 amount))
modifyValueOfPlayer src accounts (\a -> a (readDef 0 amount))
void $ newOutput (Just src) (return $ "You gave " ++ amount ++ " ecus to player " ++ show dst)
void $ newOutput (Just dst) (return $ "Player " ++ show src ++ " gaved you " ++ amount ++ "ecus")
delRule :: RuleNumber -> Rule
delRule rn = suppressRule_ rn >> autoDelete
makeKing :: PlayerNumber -> Rule
makeKing pn = do
newMsgVar_ "King" pn
void $ modifyPlayerName pn ("King " ++)
king :: MsgVar PlayerNumber
king = msgVar "King"
monarchy :: Rule
monarchy = void $ onEvent_ (ruleEvent Proposed) $ \rule -> do
k <- readMsgVar_ king
void $ onInputRadioOnce ("Your Royal Highness, do you accept rule " ++ (show $ _rNumber rule) ++ "?") [True, False] (activateOrReject rule) k
revolution :: PlayerNumber -> Rule
revolution player = do
suppressRule 1
makeKing player
rNum <- addRuleParams "Monarchy" monarchy "monarchy" "Monarchy: only the king can vote on new rules"
activateRule_ rNum
--autoDelete
victoryXRules :: Int -> Rule
victoryXRules x = setVictory $ do
rs <- getRules
let counts :: [(PlayerNumber,Int)]
counts = map (_rProposedBy . head &&& length) $ groupBy ((==) `on` _rProposedBy) rs
let victorious = map fst $ filter ((>= x) . snd) counts
return victorious
victoryXEcu :: Int -> Rule
victoryXEcu x = setVictory $ do
as <- readMsgVar accounts
let victorious as = map fst $ filter ((>= x) . snd) as
return $ maybe [] victorious as
displayTime :: Rule
displayTime = void $ outputAll $ do
t <- getCurrentTime
return $ show t
iWin :: Rule
iWin = liftEffect getProposerNumber >>= giveVictory
voteWithMajority :: Rule
voteWithMajority = onRuleProposed $ voteWith_ (majority `withQuorum` 2) $ assessOnEveryVote >> assessOnTimeDelay oneDay
returnToDemocracy :: [RuleNumber] -> Rule
returnToDemocracy rs = do
mapM_ suppressRule rs
rNum <- addRuleParams "vote with majority" voteWithMajority "voteWithMajority" "majority with a quorum of 2"
activateRule_ rNum
autoDelete
banPlayer :: PlayerNumber -> Rule
banPlayer pn = do
delPlayer pn
void $ onEvent_ (playerEvent Arrive) $ const $ void $ delPlayer pn
referendumOnKickPlayer :: Rule
referendumOnKickPlayer = referendum " kick player 2" (void $ delPlayer 2)
gameMasterElections :: Rule
gameMasterElections = do
pls <- liftEffect getPlayers
elections "Game Master" pls makeGM
makeGM :: PlayerNumber -> Nomex ()
makeGM pn = do
newMsgVar "GameMaster" pn
void $ modifyPlayerName pn ("GameMaster " ++)
gameMaster :: MsgVar PlayerNumber
gameMaster = msgVar "GameMaster"
bravoButton :: Rule
bravoButton = void $ onInputButton_ "Click here:" (const $ outputAll_ "Bravo!") 1
enterHaiku :: Rule
enterHaiku = void $ onInputTextarea_ "Enter a haiku:" outputAll_ 1
tournamentMasterCandidates :: Rule
tournamentMasterCandidates = do
let tournamentMasterCandidates = msgVar "tournamentMasterCandidates" :: MsgVar [PlayerNumber]
let candidate pn = void $ modifyMsgVar tournamentMasterCandidates (pn : )
let displayCandidates pns = return $ "Candidates for the election of Tournament Master: Players #" ++ intercalate ", " (map show pns)
newMsgVar_ (getMsgVarName tournamentMasterCandidates) ([] :: [PlayerNumber])
forEachPlayer_ (\pn -> void $ onInputButtonOnce "I am candidate for the next Tournament Master elections " (const $ candidate pn) pn)
void $ displayVar' Nothing tournamentMasterCandidates displayCandidates
data Castle = Castle { towers :: Int, dungeon :: Bool }
deriving (Typeable, Show, Eq)
castles :: MsgVar [(PlayerNumber, Castle)]
castles = msgVar "Castles"