summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorcyfraeviolae <cyfraeviolae>2020-12-31 21:25:14 -0500
committercyfraeviolae <cyfraeviolae>2020-12-31 21:25:14 -0500
commit0e90e4f442b2eb2ae9f57db49b829ab7b967890c (patch)
tree80169b7ea1f38dfe80843d6209397778b8f4673f /src
parentc145b805ab31ef19f4d5bd8f9a7d82c3a136e0e6 (diff)
small design fixes
Diffstat (limited to 'src')
-rw-r--r--src/Lib.hs30
1 files changed, 19 insertions, 11 deletions
diff --git a/src/Lib.hs b/src/Lib.hs
index e3593db..861f6f3 100644
--- a/src/Lib.hs
+++ b/src/Lib.hs
@@ -85,6 +85,9 @@ data PlayView = GameView [MediumTag] [T.Text] [Period] Level GameState (Work, Wo
| FinalView [MediumTag] [T.Text] [Period] Level [Work] [Work] Integer
newtype MediumTag = MediumTag T.Text deriving (Eq, Show, Ord, ToHttpApiData, FromHttpApiData, ToHtml)
data Period = Ancient | Postclassical | EarlyModern | Modern deriving (Eq, Show, Read, Bounded, Enum)
+renderPeriod :: Period -> T.Text
+renderPeriod EarlyModern = "Early modern"
+renderPeriod x = tshow x
data Level = Short | Long deriving (Eq, Show, Read, Bounded, Enum)
instance ToHttpApiData Period where
toUrlPiece = tshow
@@ -296,8 +299,9 @@ playURI mediumTags periods level gameState = "/" <> toUrlPiece (safeLink api (Pr
gameCrumbs :: Monad m => [MediumTag] -> [T.Text] -> [Period] -> Level -> [HtmlT m ()]
gameCrumbs _ labels periods level = [
- span_ $ toHtml $ T.intercalate ", " labels
- , span_ $ toHtml $ T.intercalate ", " (fmap tshow periods)
+ span_ $ toHtmlRaw $ T.intercalate " &middot; " labels
+ -- TODO
+ , span_ $ toHtmlRaw $ T.intercalate " &middot; " (renderPeriod <$> periods)
, span_ $ toHtml . tshow $ level ]
instance ToHtml HomeView where
@@ -367,7 +371,7 @@ feedbackPoor misses = "The Library regrets to inform you that due to the " <> (i
feedback :: Level -> Integer -> T.Text
feedback _ 0 = feedbackPerfect 0
feedback level misses =
- if (level == Short && misses <= 4) || (level == Long && misses <= 8)
+ if (level == Short && misses <= 2) || (level == Long && misses <= 7)
then feedbackMiddling misses
else feedbackPoor misses
@@ -378,7 +382,7 @@ showCard Work{name,year,wiki} = do
renderWork :: Monad m => Work -> HtmlT m () -> HtmlT m ()
renderWork Work{figures} header = div_ [class_ "work"] $ do
- div_ $ strong_ header
+ div_ header
div_ [class_ "subwork"] $ mapM_ renderFigure figures
renderFigure :: Monad m => Figure -> HtmlT m ()
renderFigure Figure{file,byline} = figure_ $ do
@@ -392,8 +396,8 @@ instance ToHtml PlayView where
body = do
div_ [class_ "row"] $ div_ [class_ "narrow"] $ do
p_ . toHtmlRaw $ feedback level misses
- p_ $ do
- a_ [href_ (playURI mediumTags periods level Nothing)] "Retry the current game"
+ p_ $ em_ $ do
+ a_ [href_ (playURI mediumTags periods level Nothing)] "Retry"
span_ ", or "
a_ [href_ homeURI] "choose different folios and periods"
span_ "."
@@ -403,7 +407,10 @@ instance ToHtml PlayView where
td_ (showCard userWork) <> td_ (showCard sortedWork))
(zip userWorks sortedWorks)
div_ [class_ "row"] $ div_ [class_ ""] $ mapM_ (\work -> do
- renderWork work $ p_ $ showCard work <> p_ (toHtml $ location work)
+ renderWork work $ p_ $ do
+ strong_ $ showCard work
+ span_ $ toHtmlRaw $ T.pack " &middot; "
+ span_ $ em_ (toHtml $ location work)
br_ []) sortedWorks
toHtml (GameView mediumTags labels periods level (GameState v s (Decisions comps)) (work1, work2)) =
pageTemplate (gameCrumbs mediumTags labels periods level) body
@@ -411,11 +418,12 @@ instance ToHtml PlayView where
body = do
div_ [class_ "row"] $ p_ $ do
strong_ . toHtml $ "Question " <> tshow (length comps + 1) <> ". "
- span_ "Select the work that was created first. Dates for ancient works are approximate and reflect when construction began."
+ span_ "Select the work that was created first."
+ small_ $ em_ " Dates for ancient works are approximate and reflect when construction began."
div_ [class_ "row"] $ do
- renderWork work1 (a_ [href_ (mkURI Less)] "Work A was created first.")
+ renderWork work1 (strong_ $ a_ [href_ (mkURI Less)] "Work A was created first.")
hr_ []
- renderWork work2 (a_ [href_ (mkURI Greater)] "Work B was created first.")
+ renderWork work2 (strong_ $ a_ [href_ (mkURI Greater)] "Work B was created first.")
mkURI nxt = playURI mediumTags periods level (Just (GameState v s (Decisions (comps ++ [nxt]))))
toHtmlRaw = toHtml
@@ -432,7 +440,7 @@ pageTemplate crumbs body = doctypehtml_ $ do
div_ [class_ "row navbar"] $
sequence_ $
L.intersperse
- (span_ [class_ "sep"] (toHtmlRaw (T.pack " &middot; ")))
+ (span_ [] (toHtmlRaw (T.pack " / ")))
(crumb : crumbs)
body
where