From a4a45c7122aa66a5240806efd4d62ee3daae0702 Mon Sep 17 00:00:00 2001 From: cyfraeviolae Date: Sat, 26 Feb 2022 12:13:53 -0500 Subject: new look --- src/Lib.hs | 59 +++++++++++++++++++++++++++++++++++------------------------ 1 file changed, 35 insertions(+), 24 deletions(-) (limited to 'src/Lib.hs') diff --git a/src/Lib.hs b/src/Lib.hs index fff2d6c..65d5c08 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -558,10 +558,20 @@ instance ToHtml HomeView where homeBody where homeBody = div_ $ do + p_ $ toHtmlRaw $ T.pack + "The passerine sorcerer, Roseacrucis, aims to destroy the connections between\ + \ the Library’s lines of poetry. If he is not stopped, each line will face\ + \ a lifetime adrift at sea, by itself and without any context." + p_ $ toHtmlRaw $ T.pack "Your task is to strengthen the network of invisible edges between each line\ + \ of poetry. Traditionally, each line only connects to one predecessor and one\ + \ successor, but circumstances require us to create additional edges, possibly backwards\ + \ or even in cycles." + p_ $ toHtmlRaw $ T.pack "Luckily, you are not alone. Other Librarians are also hard at work building\ + \ the collaborative graph of poetry we call the Spectral Renga.\ + \ Will we succeed? Can we maximize the\ + \ min-cut and minimize the max-flow? Or will Roseacrucis prevail, leaving us\ + \ bereft of such joys as enjambment, caesura, and rhyme? There’s only one way to find out." p_ $ do - strong_ [class_ "title"] "Spectral Renga" - span_ " is a collaborative graph of poetry." - p_ $ em_ $ do a_ [href_ (domainURI (DomainName "piazza"))] "Join the public piazza" span_ ", or " a_ [href_ newDomainURI] "create a private subgraph" @@ -580,19 +590,19 @@ instance ToHtml DomainView where domainBody where domainBody = do - div_ [class_ "row"] $ do + div_ $ do p_ $ do span_ (toHtmlRaw (T.pack "Welcome to ")) - strong_ [class_ "domain-name"] (toHtml domainName) + span_ [class_ "domain-name"] (toHtml domainName) span_ $ toHtml $ ". This subgraph contains " <> show numNodes <> " nodes and " <> show numEdges <> " edges." p_ $ em_ $ do a_ [href_ (domainReadURI domainName Nothing)] "Read a poem" span_ ", " a_ [href_ (domainWriteURI domainName Nothing Nothing Nothing)] "write a line" - span_ ", " + span_ ", or " a_ [href_ (domainWalkURI domainName Nothing)] "walk the graph" span_ "." - when showControls $ div_ [class_ "row manage-box"] $ do + when showControls $ div_ [class_ "manage-box"] $ do form_ [action_ (domainClearURI domainName), method_ "post", class_ "manage-form"] $ button_ [type_ "submit", class_ "manage-btn"] "Clear" form_ [action_ (domainResetURI domainName), method_ "post", class_ "manage-form"] $ @@ -614,33 +624,33 @@ instance ToHtml DomainReadView where [domainCrumb domainName, domainActionsCrumb domainName Read] (case verse of Nothing -> initialWritePrompt domainName - Just (Verse lines') -> ul_ [class_ "verse"] $ mapM_ (li_ . toHtml . DomainedLine domainName) lines') + Just (Verse lines') -> div_ [class_ "verse-container"] $ ul_ [class_ "verse"] $ mapM_ (li_ . toHtml . DomainedLine domainName) lines') toHtmlRaw = toHtml instance ToHtml DomainWriteView where toHtml (DomainWriteView domainName msrc mdst (Color color)) = pageTemplate (Just domainName) [domainCrumb domainName, domainActionsCrumb domainName Write] - (div_ [class_ "row"] $ form_ [action_ (domainWriteSubmitURI domainName), method_ "post"] $ do + (div_ $ form_ [action_ (domainWriteSubmitURI domainName), method_ "post"] $ do case msrc of - Just src@(Line (LineIden lineIdenInt) _ _) -> div_ $ do + Just src@(Line (LineIden lineIdenInt) _ _) -> p_ $ do label_ [] "previous line: " span_ $ toHtml (DomainedLine domainName src) input_ [type_ "text", name_ "src", value_ (T.pack $ show lineIdenInt), hidden_ "1"] Nothing -> div_ "" - div_ $ do + p_ $ do label_ [for_ "txt", class_ "focus"] "your line: " input_ [type_ "text", name_ "txt", id_ "txt", value_ "", maxlength_ "120", required_ "1"] - div_ $ do + p_ $ do label_ [for_ "color", class_ "focus"] "your color: " input_ [type_ "color", name_ "color", id_ "color", value_ ("#" <> color)] case mdst of - Just dst@(Line (LineIden lineIdenInt) _ _) -> div_ $ do + Just dst@(Line (LineIden lineIdenInt) _ _) -> p_ $ do input_ [type_ "text", name_ "dst", value_ (T.pack $ show lineIdenInt), hidden_ "1"] label_ [] "next line: " span_ $ toHtml (DomainedLine domainName dst) Nothing -> div_ "" - div_ $ + p_ $ input_ [type_ "submit", value_ "Submit"] ) toHtmlRaw = toHtml @@ -651,18 +661,18 @@ instance ToHtml DomainWalkView where [domainCrumb domainName, domainActionsCrumb domainName Walk] (case info of Nothing -> initialWritePrompt domainName - Just (line@(Line lineIden _ _), prevs, nexts) -> div_ [class_ "row"] $ do - div_ [class_ "neighbors"] $ do + Just (line@(Line lineIden _ _), prevs, nexts) -> div_ $ do + div_ [class_ "verse-container"] $ do small_ $ do em_ $ toHtmlRaw (T.pack "predecessors · ") em_ $ a_ [href_ (domainWriteURI domainName Nothing (Just lineIden) Nothing)] "write" case prevs of [] -> p_ "Nothing here yet." _ -> ul_ [class_ "verse"] $ mapM_ (li_ . toHtml . DomainedLine domainName) prevs - div_ [class_ "neighbors"] $ do + div_ [class_ "verse-container"] $ do small_ $ em_ "node" - p_ $ strong_ $ toHtml (DomainedLine domainName line) - div_ [class_ "neighbors"] $ do + div_ $ strong_ $ toHtml (DomainedLine domainName line) + div_ [class_ "verse-container"] $ do small_ $ do em_ $ toHtmlRaw (T.pack "successors · ") em_ $ a_ [href_ (domainWriteURI domainName (Just lineIden) Nothing Nothing)] "write" @@ -704,17 +714,18 @@ pageTemplate domainName 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_ "/spectral-renga/static/favicon.ico"] - link_ [rel_ "stylesheet", type_ "text/css", href_ "/spectral-renga/static/style.css"] + link_ [rel_ "stylesheet", type_ "text/css", href_ "/cyfraeviolae/static/styles.css"] + link_ [rel_ "stylesheet", type_ "text/css", href_ "/spectral-renga/static/styles.css"] body_ $ div_ [class_ "container"] $ do - div_ [class_ "row navbar"] $ + div_ $ sequence_ $ intersperse (span_ [class_ "sep"] (toHtmlRaw (T.pack " | "))) (crumb:crumbs) body where - crumb = span_ $ do - a_ [href_ homeURI, class_ "title"] (strong_ "Spectral Renga") + crumb = span_ [class_ "home"] $ do + a_ [href_ homeURI, class_ "title"] "Spectral Renga" span_ "@" - a_ [href_ "https://cyfraeviolae.org"] "cyfraeviolae.org" + a_ [href_ "https://cyfraeviolae.org", class_ "home-link"] "cyfraeviolae.org" titleDomain = case domainName of Nothing -> "" Just (DomainName domainNameStr) -> " - " <> domainNameStr -- cgit v1.2.3