{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ExtendedDefaultRules #-} {-# LANGUAGE CPP #-} module Game.Hanabi.Client(client, #if !defined ghcjs_HOST_OS && !defined IOS clientApp, #endif Game.Hanabi.Msg.Options(..), Game.Hanabi.Msg.defaultOptions, mkDS) where import Game.Hanabi hiding (main, rule) import qualified Game.Hanabi(rule) import Game.Hanabi.Msg import Data.Aeson hiding (Success) import GHC.Generics hiding (K1, from) import Data.Bool import Data.Char(isSpace) import qualified Data.Map as M import qualified Data.IntMap as IM import Data.Maybe(fromJust, isNothing) import Data.List(intersperse, zipWith4) import Miso hiding (Fail) import Miso.String (MisoString) import qualified Miso.String as S #ifdef ghcjs_HOST_OS client :: Game.Hanabi.Msg.Options -> IO () client options = clientJSM options #else # ifdef IOS import Language.Javascript.JSaddle.WKWebView as JSaddle client :: Game.Hanabi.Msg.Options -> IO () client options = JSaddle.run $ clientJSM options # else import Language.Javascript.JSaddle.WebSockets import Network.Wai.Handler.Warp import Network.Wai import Network.WebSockets(defaultConnectionOptions) {- This doesn't work. client :: Game.Hanabi.Msg.Options -> IO () client options = runSettings (setPort 8080 (setTimeout 3600 defaultSettings)) $ clientApp options -- Maybe the port number should be taken from options, and it should be correctly set. clientApp :: Game.Hanabi.Msg.Options -> Application clientApp options request respond = do app <- jsmToApp $ clientJSM options app request respond -} client :: Game.Hanabi.Msg.Options -> IO () client options = runSettings (setPort 8080 (setTimeout 3600 defaultSettings)) =<< clientApp options -- Maybe the port number should be taken from options, and it should be correctly set. clientApp :: Game.Hanabi.Msg.Options -> IO Application clientApp = jsmToApp . clientJSM jsmToApp :: JSM () -> IO Application jsmToApp f = jsaddleOr defaultConnectionOptions (f >> syncPoint) jsaddleApp # endif #endif -- Miso's implementation of WebSockets uses global IORef. -- https://github.com/dmjio/miso/blob/master/frontend-src/Miso/Subscription/WebSocket.hs clientJSM :: Game.Hanabi.Msg.Options -> JSM () clientJSM options = startApp App{ model = Model{tboxval = Message "available", players = ["via WebSocket"], from = Just 0, rule = defaultRule, received = [], fullHistory = False, showVerbosity = False, verbosity = verbose, play = True}, update = updateModel, view = appView strNames $ version options, subs = [ websocketSub uri protocols HandleWebSocket ], events = defaultEvents, initialAction = Id, -- initialAction = SendMessage $ Message "available", -- Seemingly sending as initialAction does not work, even if connect is executed before send. mountPoint = Nothing} where strNames = "via WebSocket" : [ S.pack name | (name, _) <- strategies options ] #ifdef URI uri = URL URI #else -- uri = URL "ws://133.54.228.39:8720" uri = URL "ws://localhost:8720" #endif protocols = Protocols [] {- At last, I chose to hide the history by default. lenHistory = 400 -- A better approach might be -- 1. to send the history to a separate frame after the endgame -- 2. to memoize renderMsg -- Also, `observe' should not send to the current player. -} updateModel :: Action -> Model -> Effect Action Model updateModel (HandleWebSocket (WebSocketMessage (Message m))) model = noEff model{ received = {- take lenHistory $ -} decodeMsg m : received model } updateModel (SendMessage msg) model = model{fullHistory=False, showVerbosity=False} <# (-- connect uri protocols >> send msg >> return Id) updateModel (UpdateTBoxVal m) model = noEff model{ tboxval = Message m } updateModel (From mbn) model = noEff model{from = mbn} updateModel IncreasePlayers model = noEff model{players = take 9 $ "via WebSocket" : players model} updateModel DecreasePlayers model = noEff model{players = case players model of {n:ns@(_:_) -> ns; ns -> ns}} updateModel (UpdatePlayer ix pl) model = noEff model{players = snd $ replaceNth ix pl $ players model} updateModel (UpdateRule r) model | isRuleValid r = noEff model{rule=r} updateModel (UpdateVerbosity v) model = noEff model{verbosity = v} updateModel Toggle model = noEff model{fullHistory = not $ fullHistory model} updateModel ToggleVerbosity model = noEff model{showVerbosity = not $ showVerbosity model} updateModel TogglePlay model | play model && length (players model) < 2 = noEff model{play = False, players = "via WebSocket" : players model} | otherwise = noEff model{play = not $ play model} #ifdef DEBUG updateModel (HandleWebSocket act) model = noEff model{received = Str (show act) : received model } #endif updateModel _ model = noEff model instance ToJSON Message instance FromJSON Message newtype Message = Message MisoString deriving (Eq, Show, Generic) data Action = HandleWebSocket (WebSocket Message) | SendMessage Message | UpdateTBoxVal MisoString | From (Maybe Int) | IncreasePlayers | DecreasePlayers | UpdatePlayer Int MisoString | UpdateRule Rule | UpdateVerbosity Verbosity | Toggle | ToggleVerbosity | TogglePlay | Id data Model = Model { tboxval :: Message , players :: [MisoString] -- REVERSED list of players other than this client , from :: Maybe Int , rule :: Rule , received :: [Msg] , fullHistory :: Bool , showVerbosity :: Bool , verbosity :: Verbosity , play :: Bool } deriving (Show, Eq) lenShownHistory = 10 appView :: [MisoString] -> String -> Model -> View Action appView strategies versionInfo mdl@Model{..} = div_ [] [ input_ [ type_ "text", placeholder_ "You can also use your keyboard.", size_ "25", onInput UpdateTBoxVal, onEnter (SendMessage tboxval) ] , button_ [ onClick (SendMessage tboxval) ] [ text (S.pack "Send to the server") ] -- x , span_ [style_ $ M.fromList [("font-size","10px")]] [text $ S.pack "(Use this line if you prefer the keyboard interface.)"] , span_ [style_ $ M.fromList [("float","right")]] [ button_ [ onClick ToggleVerbosity, id_ "verbutton" ] [ text $ if showVerbosity then "^" else "v" ] , label_ [for_ "verbutton"] [text "verbosity options" ] ] , if showVerbosity then span_ [style_ $ M.fromList [("clear","both"), ("float","right")]] [renderVerbosity verbosity] else span_[][] , span_ [style_ $ M.fromList [("clear","both"), ("font-size","10px"), ("float","right")]] [text $ S.pack $ "hanabi-dealer client "++versionInfo] -- , hr_ [] , div_ [style_ $ M.fromList [("clear","both")]] ((if fullHistory then id else take lenShownHistory) $ map (renderMsg strategies verbosity mdl) received) , div_ [] $ if null $ drop lenShownHistory received then [] else [ hr_ [] , input_ [ type_ "checkbox", id_ "showhist", onClick Toggle, checked_ fullHistory] , label_ [for_ "showhist"] [text "Show full history"] ] ] renderVerbosity :: Verbosity -> View Action renderVerbosity v = div_ [] [ mkChx v "mark unhinted critical cards" (\b -> v{warnCritical=b}) warnCritical, mkChx v "mark useless cards" (\b -> v{markUseless=b}) markUseless, mkChx v "mark playable cards" (\b -> v{markPlayable=b}) markPlayable, mkChx v "mark useless cards without looking at the cards" (\b -> v{markObviouslyUseless=b}) markObviouslyUseless, mkChx v "mark playable cards without looking at the cards" (\b -> v{markObviouslyPlayable=b}) markObviouslyPlayable, mkChx v "shade the chop card(s)" (\b -> v{markChops=b}) markChops, mkChx v "warn possible double-dropping"(\b -> v{warnDoubleDrop=b}) warnDoubleDrop, mkChx v "mark hints" (\b -> v{markHints=b}) markHints, mkChx v "mark possibilities" (\b -> v{markPossibilities=b}) markPossibilities ] mkChx verb label update access = div_ [] [ input_ [ type_ "checkbox", id_ idName, onClick (UpdateVerbosity $ update $ not $ access verb), checked_ $ access verb ], label_ [ for_ idName ] [text label] ] where idName = S.filter (not.isSpace) label onEnter :: Action -> Attribute Action onEnter action = onKeyDown $ bool Id action . (== KeyCode 13) {- #ifdef AESON prettyDecode :: MisoString -> MisoString prettyDecode str = case decode $ S.fromMisoString str of Nothing -> str Just msg -> S.toMisoString $ encode $ prettyMsg verbose msg #else prettyDecode :: MisoString -> MisoString prettyDecode str = case reads $ S.fromMisoString str of [] -> str [(msg,_)] -> S.toMisoString $ prettyMsg verbose msg #endif render :: MisoString -> View Action render str = case decode str' of Nothing -> text $ S.fromMisoString str Just msg -> renderMsg verbose msg where str' = S.fromMisoString str -} decodeMsg :: MisoString -> Msg #ifdef AESON decodeMsg str = case decode $ S.fromMisoString str of Nothing -> Str $ S.fromMisoString str Just msg -> msg #else decodeMsg str = case reads $ S.fromMisoString str of [] -> Str $ S.fromMisoString str [(msg,_)] -> msg #endif renderMsg :: [MisoString] -> Verbosity -> Model -> Msg -> View Action renderMsg _ _ _ (Str xs) = div_ [] [hr_ [], pre_ [] [ text $ S.pack xs ]] renderMsg _ verb _ (WhatsUp name ps ms) = renderWhatsUp verb name ps ms renderMsg _ verb _ (WhatsUp1 p m) = renderWhatsUp1 verb p m renderMsg _ _ _ (PrettyEndGame Nothing) = pre_ [] [ text $ S.pack $ prettyMbEndGame Nothing] renderMsg _ verb _ (PrettyEndGame (Just tup)) = renderEndGame verb tup -- pre_ [] [ text $ S.pack $ prettyEndGame tup] renderMsg _ verb _ (Watch st) = renderSt verb ithPlayerFromTheLast st renderMsg strategies _ mdl (PrettyAvailable games) = div_ [style_ $ M.fromList [("overflow","auto")]] [ hr_ [], table_ [style_ $ M.fromList [("border-style","solid"), ("clear","both"), ("float","right")]] $ caption_ [] [text $ S.pack "Available games", button_ [onClick $ SendMessage $ Message "available"] [text $ S.pack "refresh"]] : tr_ [] [ th_ [solid] [text $ S.pack str] | str <- ["Game ID", "available", "total"] ] : map renderAvailable games, div_ [] [ table_ [solid] $ caption_ [textProp "text-align" "left", textProp "margin-left" "auto"] [ -- Seemingly these styles do not work. text "Players", button_ [onClick IncreasePlayers] [text $ S.pack "+"], button_ [onClick DecreasePlayers] [text $ S.pack "-"], input_ [type_ "radio", id_ "shuffle", onClick (From Nothing), checked_ $ from mdl == Nothing], label_ [for_ "shuffle"] [text "shuffle on startup"] ] : -- table_ [solid] $ [ tr_ [] [td_ [solid] [x], td_ [] (if n>=0 then [input_ [type_ "radio", id_ iD, onClick (From $ Just n), checked_ $ from mdl == Just n], label_ [for_ iD] [text "Turn 0"]] else [])] | (n,x) <- zip [if play mdl then 0 else -1 ..] $ you : reverse (zipWith (renderPlayer strategies) [0..] (players mdl)) , let iD = S.pack $ "radio"++show n ] -- x ++ [tr_ [] [td_ [] [], td_ [] [input_ [type_ "radio", id_ "shuffle", onClick (From Nothing), checked_ $ from mdl == Nothing], -- label_ [for_ "shuffle"] [text "shuffle the player list before the game"]]]] , -- div_ [] [text $ "Rules"], -- div_ [] [input_ [type_ "text", onInput (UpdateRule . head . (++[rule mdl]) . map fst . reads . S.unpack), value_ $ S.pack $ show $ rule mdl, style_ $ M.fromList [("width","70%")]]], let mkTR label updater access = tr_ [] [ td_ [] [text label], td_ [] [ input_ [type_ "text", onInput (UpdateRule . updater . head . (++[access $ rule mdl]) . map fst . reads . S.unpack), value_ $ S.pack $ show $ access $ rule mdl] ] ] mkTRd label updater access options = tr_ [] [ td_ [] [text label], td_ [] [ dropdownLiteral options (UpdateRule . updater) (access $ rule mdl) ] ] in table_ [solid] [ caption_ [] [text "Rules"], mkTRd "Number of lives" (\n -> (rule mdl){numBlackTokens=n}) numBlackTokens [1 .. 9], mkTRd "Number of colors" (\n -> (rule mdl){numColors=n}) numColors [1 .. 6], mkTRd "Continue the game after the pile is exhausted" (\n -> (rule mdl){prolong=n}) prolong [False,True], mkTR "numMulticolors" (\n -> (rule mdl){numMulticolors=n}) numMulticolors, mkTR "funPlayerHand" (\n -> (rule mdl){funPlayerHand=n}) funPlayerHand ], button_ [onClick $ SendMessage $ Message $ S.pack $ (case from mdl of Just n | play mdl -> "from " ++ shows n " " | otherwise -> "observe " ++ shows n " " Nothing | play mdl -> "shuffle " | otherwise -> "observe ") ++ show (rule mdl) ++ concat (intersperse "," $ map S.unpack $ reverse $ players mdl)] [text $ S.pack "create a game"] ] ] where you = span_[][ input_ [ type_ "checkbox", id_ "you", onClick TogglePlay, checked_ $ play mdl] , label_ [for_ "you"] [if play mdl then text "You" else s_ [] [text "You"]] ] renderPlayer :: [MisoString] -> Int -> MisoString -> View Action --renderPlayer _ i p = text p renderPlayer strategies i p = dropdown strategies (UpdatePlayer i) p dropdown :: [MisoString] -> (MisoString->Action) -> MisoString -> View Action dropdown options action selected = select_ [onChange action] [option_ [ value_ p, selected_ $ selected==p] [text p] | p <- options ] dropdownLiteral :: (Read a, Show a) => [a] -> (a -> Action) -> a -> View Action dropdownLiteral options action selected = dropdown (map (S.pack . show) options) (action . read . S.unpack) (S.pack $ show selected) dropdownBool = dropdownLiteral [False,True] -- but in most cases booleans should be selected by check boxes. renderAvailable (gameid, (missing, total)) = tr_ [onClick $ SendMessage $ Message $ S.pack $ "attend "++show gameid] [ td_ [solid] [text $ S.pack str] | str <- [show gameid, show missing, show total] ] solid = style_ $ M.fromList [("border-style","solid")] renderWhatsUp verb name views@(v:_) moves = div_ [] [ hr_ [], text $ S.pack "Your turn.", hr_ [], renderRecentEvents verb (publicView v) ithPlayer views moves, hr_ [], text $ S.pack $ "Algorithm: " ++ name, renderPV verb v ] renderWhatsUp1 :: Verbosity -> PrivateView -> Move -> View Action renderWhatsUp1 verb v m = div_ [style_ $ M.fromList [("background-color","#555555"),("color","#000000")]] [ hr_ [], renderTrial verb (publicView v) (const "") undefined v m, hr_ [], renderPV verb v ] renderEndGame :: Verbosity -> (EndGame, [State], [Move]) -> View Action renderEndGame verb (eg,sts@(st:_),mvs) = div_ [] [ hr_ [], renderRecentEvents verb (publicState st) ithPlayerFromTheLast (map Game.Hanabi.view sts) mvs, hr_ [], h1_ [style_ $ M.fromList [("background-color","#FF0000"),("color","#000000")]] [text $ S.pack $ show eg], hr_ [], renderSt verb ithPlayerFromTheLast st, hr_ [] ] renderTrial :: Verbosity -> PublicInfo -> (Int -> String) -> Int -> PrivateView -> Move -> View Action renderTrial verb pub ithP i v m = div_ [] [ text $ S.pack $ ithP i ++ " move: " ++ {- replicate (length (ithP 2) - length (ithP i)) ' ' ++ -} show m , case result $ publicView v of Discard c -> showResults c ", which revealed " Success c -> showResults c ", which succeeded revealing " Fail c -> showResults c ", which failed revealing " _ -> text $ S.pack "" ] where showResults c xs = span_ [] [ xs -- , renderHand' verbose pub [Just c] [(Nothing,Nothing)] , renderCardInline verb pub c , text $ S.pack "." ] renderPI verb pub {- This was too verbose = let showDeck 0 = "no card at the deck (the game will end in " ++ shows (fromJust $ deadline pub) " turn(s)), " showDeck 1 = "1 card at the deck, " showDeck n = shows n " cards at the deck, " in "Turn "++ shows (turn pub) ": " ++ showDeck (pileNum pub) ++ shows (lives pub) " live(s) left, " ++ shows (hintTokens pub) " hint tokens;\n\n" -} = let showDeck 0 = if prolong $ Game.Hanabi.rule $ gameSpec pub then "Deck: 0, " else "Deck: 0 (" ++ shows (fromJust $ deadline pub) " turn(s) left), " showDeck 1 = "Deck: 1, " showDeck n = "Deck: " ++ shows n ", " in div_ [] [ text $ S.pack $ "Turn: "++ shows (turn pub) ", " ++ showDeck (pileNum pub) ++ "Lives: " ++ shows (lives pub) ", Hints: " ++ shows (hintTokens pub) ";", div_ [] [ text $ S.pack $ "played:", span_ [] [ span_ [] $ text (S.pack "|") : [ renderCardInline verb pub $ C c k | k <- [K1 .. playedMax]] | c <- [White .. Multicolor], Just playedMax <- [IM.lookup (fromEnum c) (played pub)] ], text $ S.pack "|" ], div_ [] [ text $ S.pack $ "dropped: ", span_ [] [ span_ [] $ text (S.pack "|") : (replicate n $ renderCardInline verb pub $ intToCard ci) | (ci,n) <- IM.toList $ discarded pub ], text $ S.pack "|" ] ] renderCardInline v pub c = span_ [style_ $ M.fromList [("width","30px"),("color", colorStr $ Just $ color c),("background-color","#000000")]] [cardStr v pub 0 (Just c) (Nothing,Nothing)] renderRecentEvents :: Verbosity -> PublicInfo -> (Int -> Int -> String) -> [PrivateView] -> [Move] -> View Action renderRecentEvents verb pub ithP vs@(v:_) ms = div_ [] $ reverse $ zipWith3 (renderTrial verb pub $ ithP nump) [pred nump, nump-2..0] vs ms where nump = numPlayers $ gameSpec $ publicView v renderPV :: Verbosity -> PrivateView -> View Action renderPV v pv@PV{publicView=pub} = div_ [] [ renderPI v pub, div_ [] ( -- div_ [] [text $ S.pack $ "My hand:"] : -- renderCards v pub [ Nothing | _ <- myHand] myHand : renderHand v pv (const "My") 0 [ Nothing | _ <- myHand] myHand (head $ possibilities pub) : -- ++ concat [ '+':shows d "-" | d <- [0 .. pred $ length myHand] ] (zipWith4 (renderHand v pv (ithPlayer $ numPlayers $ gameSpec pub)) [1..] (map (map Just) $ handsPV pv) (tail $ givenHints pub) (tail $ possibilities pub)) ) ] where myHand = head (givenHints pub) renderSt verb ithP st@St{publicState=pub} = div_ [] $ renderPI verb pub : zipWith4 (renderHand verb (Game.Hanabi.view st) (ithP $ numPlayers $ gameSpec pub)) [0..] (map (map Just) $ hands st) (givenHints pub) (possibilities pub) renderHand :: Verbosity -> PrivateView -> (Int->String) -> Int -> [Maybe Card] -> [Marks] -> [Possibilities] -> View Action renderHand v pv ithPnumP i mbcards hl ps = div_ [] [ div_ [] [text $ S.pack $ ithPnumP i ++ " hand:"], renderHand' v pv i mbcards hl ps -- renderCards v pub (map Just cards) hl ] renderHand' :: Verbosity -> PrivateView -> Int -> [Maybe Card] -> [Marks] -> [Possibilities] -> View Action renderHand' v pv pli mbcards hl ps = table_ [style_ $ M.fromList [("border-color","#FFFFFF"), ("border-width","medium")]] [tr_ [style_ $ M.fromList [("background-color","#000000"), ("height","48px")]] (zipWith4 (renderCard v pv pli hl ps) [0..] mbcards hl ps)] renderCard :: Verbosity -> PrivateView -> Int -> [Marks] -> [Possibilities] -> Index -> Maybe Card -> Marks -> Possibilities -> View Action renderCard v pv pli hl ps i mbc tup@(mc,mk) ptup@(pc,pn) = td_ [style_ $ M.fromList [("width","4em"), ("color", colorStr $ fmap color mbc)]] [ maybe (button_ [ onClick (SendMessage $ Message $ S.pack $ 'p':show i) ] [ text (S.pack "play") ]) (const $ span_[][]) mbc, div_ [] [ cardStr v pub pli mbc tup ], div_ [myStyle] [text $ S.pack $ if markHints v then maybe '_' (head . show) mc : [maybe '_' (head . show . fromEnum) mk] else "__" ], maybe (button_ [ onClick (SendMessage $ Message $ S.pack $ 'd':show i) ] [ text (S.pack "drop") ]) (const $ span_[][]) mbc, if markPossibilities v then div_ [style_ $ M.fromList [("font-size","0.8em")]] [text $ S.pack $ showColorPossibilities pc, br_[], text $ S.pack $ showNumberPossibilities pn] else span_[][] ] where pub = publicView pv myStyle | isNothing mbc = style_ $ M.fromList [ ("background-color", if warnDoubleDrop v && isDoubleDrop pv (result pub) chopSet ptup && i `elem` chopSet then "#880000" else if markChops v && i `elem` chopSet then "#888888" else "#000000"), ("font-weight", if markObviouslyUseless v && isDefinitelyUseless pv tup ptup then "100" else "normal"), ("font-style", if markObviouslyPlayable v && isDefinitelyPlayable pv tup ptup then "oblique" else "normal")] | otherwise = style_ $ M.fromList [ ("background-color",if markChops v && i `elem` concat (take 1 $ obviousChopss pub hl ps) then "#888888" else "#000000"), ("font-weight", if markObviouslyUseless v && isObviouslyUseless pub ptup then "100" else "normal"), ("font-style", if markObviouslyPlayable v && isObviouslyPlayable pub ptup then "oblique" else "normal")] chopSet = concat $ take 1 $ definiteChopss pv hl ps {- renderCards :: Verbosity -> PublicInfo -> [Maybe Card] -> [Marks] -> View Action renderCards v pub mbcs tups = table_ [style_ $ M.fromList [("border-color","#FFFFFF"),("border-width","medium")]] [ tr_ [style_ $ M.fromList [("background-color","#000000")]] [ td_ [style_ $ M.fromList [("color", colorStr $ fmap color mbc)]] [ cardStr v pub mbc tup ] | (mbc,tup) <- zip mbcs tups ], tr_ [style_ $ M.fromList [("background-color","#000000")]] [ td_ [style_ $ M.fromList [("color", colorStr $ fmap color mbc)]] [ text $ S.pack $ if markHints v then maybe ' ' (head . show) mc : [maybe ' ' (head . show . fromEnum) mk] else "" ] | (mbc,(mc,mk)) <- zip mbcs tups ] ] -} -- Not sure which style is better. #ifdef BUTTONSONCARDS cardStr v pub pli mbc tup = case mbc of Nothing -> span_ [] [text $ S.pack "??"] Just c -> span_ [] [ -- text $ S.pack $ show c button_ [onClick (SendMessage $ Message $ S.pack $ shows pli $ take 1 $ show $ color c), style] [text $ S.pack $ take 1 $ show $ color c], button_ [onClick (SendMessage $ Message $ S.pack $ shows pli $ show $ fromEnum $ number c), style][text $ S.pack $ show $ fromEnum $ number c] ] where style = style_ $ M.fromList [ ("font-weight", if markUseless v && isUseless pub c then "100" else if warnCritical v && tup==(Nothing,Nothing) && isCritical pub c then "bold" else "normal"), ("font-style", if markPlayable v && isPlayable pub c then "oblique" else "normal"), ("background-color","#000000"),("color", colorStr $ fmap color mbc)] #else cardStr v pub pli mbc tup = case mbc of Nothing -> span_ [] [text $ S.pack "??"] Just c -> span_ [style] [ -- text $ S.pack $ show c span_ [style_ $ M.fromList [("font-size","20px")], onClick (SendMessage $ Message $ S.pack $ shows pli $ take 1 $ show $ color c)] [text $ S.pack $ take 1 $ show $ color c], span_ [style_ $ M.fromList [("font-size","20px")], onClick (SendMessage $ Message $ S.pack $ shows pli $ show $ fromEnum $ number c)][text $ S.pack $ show $ fromEnum $ number c] ] where style = style_ $ M.fromList [-- ("width","30px"), ("font-weight", if markUseless v && isUseless pub c then "100" else if warnCritical v && tup==(Nothing,Nothing) && isCritical pub c then "bold" else "normal"), ("font-style", if markPlayable v && isPlayable pub c then "oblique" else "normal")] #endif colorStr Nothing = "#00FFFF" colorStr (Just White) = "#FFFFFF" colorStr (Just Yellow) = "#FFFF00" colorStr (Just Red) = "#FF4444" colorStr (Just Green) = "#44FF44" colorStr (Just Blue) = "#8888FF" colorStr (Just Multicolor) = "#FF00FF"