summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Lib.hs59
1 files changed, 35 insertions, 24 deletions
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 <em>Spectral Renga</em>.\
+ \ 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&rsquo;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 &middot; ")
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 &middot; ")
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-24 23:20:44 +0000