diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Lib.hs | 72 |
1 files changed, 41 insertions, 31 deletions
@@ -348,21 +348,22 @@ playURI mediumTags periods level gameState = "/" <> toUrlPiece (safeLink api (Pr gameCrumbs :: Monad m => [MediumTag] -> [T.Text] -> [Period] -> Level -> [HtmlT m ()] gameCrumbs _ labels periods level = - [ span_ $ toHtmlRaw $ T.intercalate " · " labels, - span_ $ toHtmlRaw $ T.intercalate " · " (renderPeriod <$> periods), + [ span_ $ toHtmlRaw $ T.intercalate ", " labels, + span_ $ toHtmlRaw $ T.intercalate ", " (renderPeriod <$> periods), span_ $ toHtml . tshow $ level ] instance ToHtml HomeView where toHtml (HomeView (Manifest mediums)) = pageTemplate - [a_ [href_ "https://cyfraeviolae.org/git/antiquitysort", class_ "nonbreaking"] "source code"] + [] homeBody where - homeBody = div_ [class_ "narrow"] $ do + homeBody = div_ $ do p_ $ toHtmlRaw $ T.pack "The spectral sorcerer Roseacrucis has cast his nefarious randomizing algorithms upon the Library’s chronicles. Your mission is to restore the well‐ordering of our cultural histories." + br_ [] form_ [method_ "get", action_ "/antiquitysort/play"] $ do - fieldset_ $ do + div_ $ do legend_ "Folios" forM_ mediums $ \Medium {tag = (MediumTag tagm), label, description, disabled} -> div_ $ do input_ $ @@ -370,44 +371,47 @@ instance ToHtml HomeView where ++ [checked_ | tagm == "ReligiousArchitecture"] ++ [disabled_ "1" | disabled] label_ (for_ tagm : [class_ "disabled" | disabled]) $ do - span_ $ strong_ $ toHtml label <> ". " + span_ $ toHtml label <> ". " if disabled then span_ "Coming soon." else span_ $ toHtmlRaw description - fieldset_ $ do + br_ [] + div_ $ do legend_ "Periods" div_ $ do input_ [type_ "checkbox", name_ "p", value_ "Ancient", id_ "Ancient", checked_] label_ [for_ "Ancient"] $ do - span_ $ strong_ "Ancient " + span_ $ "Ancient " span_ $ toHtmlRaw $ T.pack "(3000 BCE—600 CE)" div_ $ do input_ [type_ "checkbox", name_ "p", value_ "Postclassical", id_ "Postclassical"] label_ [for_ "Postclassical"] $ do - span_ $ strong_ "Postclassical " + span_ $ "Postclassical " span_ $ toHtmlRaw $ T.pack "(400 CE—1600 CE)" div_ $ do input_ [type_ "checkbox", name_ "p", value_ "EarlyModern", id_ "EarlyModern"] label_ [for_ "EarlyModern"] $ do - span_ $ strong_ "Early modern " + span_ $ "Early modern " span_ $ toHtmlRaw $ T.pack "(1400 CE—1850 CE)" div_ $ do input_ [type_ "checkbox", name_ "p", value_ "Modern", id_ "Modern"] label_ [for_ "Modern"] $ do - span_ $ strong_ "Modern " + span_ $ "Modern " span_ $ toHtmlRaw $ T.pack "(1750 CE—)" - fieldset_ $ do + br_ [] + div_ $ do legend_ "Duration" div_ $ do input_ [type_ "radio", name_ "l", value_ "Short", id_ "Short", checked_] label_ [for_ "Short"] $ do - span_ $ strong_ "Short " + span_ $ "Short " span_ "(6 works, less than 11 questions)" div_ $ do input_ [type_ "radio", name_ "l", value_ "Long", id_ "Long"] label_ [for_ "Long"] $ do - span_ $ strong_ "Long " + span_ $ "Long " span_ "(10 works, less than 25 questions)" + br_ [] button_ [type_ "submit"] "Start" toHtmlRaw = toHtml @@ -435,11 +439,12 @@ showCard Work {name, year, wiki} = do renderWork :: Monad m => Work -> HtmlT m () -> HtmlT m () renderWork Work {figures} header = div_ [class_ "work"] $ do div_ header - div_ [class_ "subwork"] $ mapM_ renderFigure figures + div_ [class_ "wrapper"] $ mapM_ renderFigure figures renderFigure :: Monad m => Figure -> HtmlT m () renderFigure Figure {file, byline} = figure_ $ do img_ [src_ ("/antiquitysort/static/assets/" <> file)] + br_ [] figcaption_ $ toHtml byline instance ToHtml PlayView where @@ -447,8 +452,8 @@ instance ToHtml PlayView where pageTemplate (gameCrumbs mediumTags labels periods level) body where body = do - div_ [class_ "row"] $ - div_ [class_ "narrow"] $ do + div_ $ + div_ $ do p_ . toHtmlRaw $ feedback level misses p_ $ em_ $ do @@ -456,7 +461,8 @@ instance ToHtml PlayView where span_ " or " a_ [href_ homeURI] "choose different folios and periods" span_ "." - div_ [class_ "row"] $ + br_ [] + div_ $ table_ $ do tr_ $ th_ "Your ordering" <> th_ "Correct ordering" mapM_ @@ -465,8 +471,8 @@ instance ToHtml PlayView where td_ (showCard userWork) <> td_ (showCard sortedWork) ) (zip userWorks sortedWorks) - div_ [class_ "row"] $ - div_ [class_ ""] $ + div_ $ + div_ $ mapM_ ( \work -> do renderWork work $ @@ -481,12 +487,14 @@ instance ToHtml PlayView where pageTemplate (gameCrumbs mediumTags labels periods level) body where body = do - div_ [class_ "row"] $ + div_ $ p_ $ do strong_ . toHtml $ "Question " <> tshow (length comps + 1) <> ". " span_ "Select the work that was created first." + br_ [] small_ $ em_ " Dates for ancient works are approximate and reflect when construction began." - div_ [class_ "row"] $ do + br_ [] + div_ $ do renderWork work1 (strong_ $ a_ [href_ (mkURI Less)] "Work A was created first.") hr_ [] renderWork work2 (strong_ $ a_ [href_ (mkURI Greater)] "Work B was created first.") @@ -500,20 +508,22 @@ pageTemplate crumbs body = doctypehtml_ $ do meta_ [charset_ "utf-8"] meta_ [name_ "viewport", content_ "width=device-width, initial-scale=1.0"] link_ [rel_ "shortcut icon", type_ "image/x-icon", href_ "/antiquitysort/static/favicon.ico"] - link_ [rel_ "stylesheet", type_ "text/css", href_ "/antiquitysort/static/style.css"] + link_ [rel_ "stylesheet", type_ "text/css", href_ "/static/styles.css"] + link_ [rel_ "stylesheet", type_ "text/css", href_ "/antiquitysort/static/styles.css"] body_ $ div_ [class_ "container"] $ do - div_ [class_ "row navbar"] $ - sequence_ $ + div_ $ do + div_ [class_ "home"] $ do + a_ [href_ homeURI, class_ "home-title"] (strong_ "Antiquitysort") + span_ " at " + a_ [href_ "/"] "cyfraeviolae.org" + div_ [class_ "crumbs"] $ sequence_ $ L.intersperse - (span_ [class_ "sep"] (toHtmlRaw (T.pack " | "))) - (crumb : crumbs) + (span_ [class_ "sep"] (toHtmlRaw (T.pack " · "))) + (srcCrumb : crumbs) body where - crumb = span_ [class_ "ico"] $ do - a_ [href_ homeURI, class_ "title"] (strong_ "Antiquitysort") - span_ "@" - a_ [href_ "https://cyfraeviolae.org"] "cyfraeviolae.org" + srcCrumb = a_ [href_ "/git/antiquitysort"] "source code" tshow :: Show a => a -> T.Text tshow = T.pack . show |