module loco import iTasks, Random derive bimap (,), Maybe derive class iTask Loco, Player, Color, LocoTable, ColorItem :: Loco = { table :: LocoTable , players :: [Player] } :: LocoTable= { turn :: Int , stack :: Cards , chips :: Chips } :: Player = { cards :: Cards , chips :: Chips } :: Color = Red | Green | Blue | Black | Purple :: Cards :== ColorItem [Int] :: Chips :== ColorItem Int :: ColorItem a = { red :: a , green :: a , blue :: a , black :: a , purple :: a } numberOfPlayers = 4 cardsPerPlayer = 7 numberOfCards = numberOfPlayers * cardsPerPlayer + 2 numberOfColors = length allColors allColors = [Red, Green, Blue, Black, Purple] maxCardValue = 6 cardValues = [1..maxCardValue] initLocoGame :: Int -> Loco initLocoGame seed = initLoco (mapToColor (shakeCards [1..numberOfCards] [] (genRandInt seed))) where initLoco :: [(Color,Int)] -> Loco initLoco cards = { table = initTable , players = [initPlayers (cards%(cardsPerPlayer*(i-1),cardsPerPlayer*i-1)) \\ i <- [1..numberOfPlayers]] } initTable :: LocoTable initTable = { turn = 1 , stack = initColorItem (repeat []) , chips = initColorItem (repeat 6) } initPlayers :: [(Color,Int)] -> Player initPlayers cards = { cards = convert cards (initColorItem (repeat [])) , chips = initColorItem (repeat 0) } where convert [] deck = deck convert [(Red,i):cs] deck = convert cs {deck & red = deck.red ++ [i]} convert [(Green,i):cs] deck = convert cs {deck & green = deck.red ++ [i]} convert [(Blue,i):cs] deck = convert cs {deck & blue = deck.red ++ [i]} convert [(Black,i):cs] deck = convert cs {deck & black = deck.red ++ [i]} convert [(Purple,i):cs] deck = convert cs {deck & purple = deck.red ++ [i]} mapToColor :: [Int] -> [(Color,Int)] mapToColor cards = [(allColors !! detColor card maxCardValue 0,1 + card rem maxCardValue) \\ card <- cards] where detColor card val n | card <= val = n = detColor card (val+maxCardValue) (n+1) shakeCards :: [Int] [Int] [Int] -> [Int] shakeCards [] accu _ = accu shakeCards cards accu [s:ss] # index = (abs s) rem (length cards) = shakeCards (removeAt index cards) [cards!!index:accu] ss initColorItem as = { red = as!!0 , green = as!!1 , blue = as!!2 , black = as!!3 , purple = as!!4 } instance toString Color where toString Red = "red" toString Green = "green" toString Blue = "blue" toString Black = "black" toString Purple = "purple" showColVal color label = toHtmlDisplay [SpanTag [StyleAttr ("color:" +++ (toString color))] [Text (toString label)]] // ------------------- Start w = startEngine [workflow "test" "test loco" locoWorkflow] w normalTask user = { worker = user, priority = NormalPriority, deadline = Nothing, status = Active} locoWorkflow = readShared sharedCurrentTime >>= \time -> parallel "Loco Player" (initLocoGame (time.hour + time.min + time.sec)) noResult [DetachedTask (normalTask RootUser) noMenu (player i) \\ i <- [1..numberOfPlayers]] where noResult _ _ = Void player i s os = monitor "Table" toViewTable (\_ -> False) False s ||- updateSharedInformationA ("Player " <+++ i) (toViewPlayer,fromViewPlayer) [] s where toViewTable s = Display s.table toViewPlayer s = Display (s.players!!(i-1)) fromViewPlayer v s = s