From 49157c27f2aadb32d1497b9d972403aa87a5eb95 Mon Sep 17 00:00:00 2001 From: towards-a-new-leftypol Date: Mon, 19 Feb 2024 13:02:16 -0500 Subject: [PATCH] Add input range time control - add component module - hook up events, update function etc --- chandlr.cabal | 1 + html/README.hs | 5 +++ html/scroll.js | 16 ++++++++ html/scrollbar.html | 19 +++++++++ html/tc.css | 43 ++++++++++++++++++++ html/timecontrol.html | 1 + index.html | 7 ++++ src/Action.hs | 3 ++ src/Component/TimeControl.hs | 79 ++++++++++++++++++++++++++++++++++++ src/Main.hs | 13 +++++- 10 files changed, 185 insertions(+), 2 deletions(-) create mode 100644 html/README.hs create mode 100644 html/scroll.js create mode 100644 html/scrollbar.html create mode 100644 html/tc.css create mode 100644 html/timecontrol.html create mode 100644 src/Component/TimeControl.hs diff --git a/chandlr.cabal b/chandlr.cabal index 610bcff..c8ab120 100644 --- a/chandlr.cabal +++ b/chandlr.cabal @@ -82,6 +82,7 @@ executable chandlr BodyParser QuoteLinkParser PostPartType + Component.TimeControl -- LANGUAGE extensions used by modules in this package. diff --git a/html/README.hs b/html/README.hs new file mode 100644 index 0000000..5c26190 --- /dev/null +++ b/html/README.hs @@ -0,0 +1,5 @@ +You can use these snippets to generate Miso view syntax + +```bash +cat timecontrol.html | miso-from-html +``` diff --git a/html/scroll.js b/html/scroll.js new file mode 100644 index 0000000..904bbe9 --- /dev/null +++ b/html/scroll.js @@ -0,0 +1,16 @@ +function onChange(e) { + console.log(e.target.value); +} + +function main() { + console.log("Hello world"); + var elem_range = document.querySelector("input.time-control"); + console.log(elem_range); + elem_range.addEventListener('input', onChange); +} + +if (document.readyState != "complete") { + window.addEventListener("load", main, { "once": true }) +} else { + main(); +} diff --git a/html/scrollbar.html b/html/scrollbar.html new file mode 100644 index 0000000..190d2f6 --- /dev/null +++ b/html/scrollbar.html @@ -0,0 +1,19 @@ + + + + + Scrollbar demo + + + + +
+
+
+
+
+
+
+ + + diff --git a/html/tc.css b/html/tc.css new file mode 100644 index 0000000..cf572e1 --- /dev/null +++ b/html/tc.css @@ -0,0 +1,43 @@ +.timecontrol { + overflow-x: hidden; +} + +.tc-scrollbar__wrapper, +.time-control { + width: 70%; + margin-left: auto; + margin-right: auto; + display: block; +} + +.tc-scrollbar__bar { + width: 100%; + height: 20px; + border-left: 2px solid black; + border-right: 2px dotted black; + position: relative; + box-sizing: border-box; +} + +.tc-scrollbar__bar:before { + content: ""; + display: block; + float: left; + width: 150%; + width: 100%; + height: 1px; + background-color: black; + position: relative; + top: calc(50% - .5px); +} + +.tc-scrollbar__scroller { + height: 100%; + width: 20px; + box-sizing: border-box; + border: 3px solid black; + border-radius: 50%; + background-color: white; + position: absolute; + right: 0; +} diff --git a/html/timecontrol.html b/html/timecontrol.html new file mode 100644 index 0000000..8f5ea64 --- /dev/null +++ b/html/timecontrol.html @@ -0,0 +1 @@ + diff --git a/index.html b/index.html index 5fc8ee2..672d21e 100644 --- a/index.html +++ b/index.html @@ -15,6 +15,13 @@ .post.reply.multifile .body { clear: both; } + + .time-slider { + width: 70%; + margin-left: auto; + margin-right: auto; + display: block; + } diff --git a/src/Action.hs b/src/Action.hs index e60fc21..bba52fd 100644 --- a/src/Action.hs +++ b/src/Action.hs @@ -13,6 +13,8 @@ import Network.CatalogPostType (CatalogPost) import Network.Http (HttpResult) import Network.SiteType (Site) import qualified Component.ThreadView as Thread +import qualified Component.ThreadView as Thread +import qualified Component.TimeControl as TC data GetThreadArgs = GetThreadArgs { website :: Text @@ -28,5 +30,6 @@ data Action | HaveThread (HttpResult [ Site ]) | forall a. (FromJSON a) => ClientAction (HttpResult a -> Action) (C.Action a) | ThreadAction Thread.Action + | TimeAction TC.Time | ChangeURI URI | NoAction diff --git a/src/Component/TimeControl.hs b/src/Component/TimeControl.hs new file mode 100644 index 0000000..66a2526 --- /dev/null +++ b/src/Component/TimeControl.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Component.TimeControl where + +import Miso + ( View + , div_ + , class_ + , input_ + , step_ + , min_ + , max_ + , type_ + , value_ + , (<#) + , consoleLog + , Effect + , noEff + , onInput + , onChange + ) + +import Miso.String (toMisoString) +import Data.Time.Clock (UTCTime) +import GHCJS.DOM.Types (JSString) + +data Time + = Now + | At UTCTime + | NoAction + | SlideInput JSString + | SlideChange JSString + deriving Show + +data Interface a = Interface + { passAction :: Time -> a + } + +view :: Interface a -> View a +view iface = + div_ + [ class_ "time-control" + ] + [ input_ + [ class_ "time-slider" + , type_ "range" + , min_ "-500" + , max_ "0" + , step_ "1" + , value_ "0" + , onInput $ pass SlideInput + , onChange $ pass SlideChange + ] + ] + + where + pass action = \t -> passAction iface $ action t + +update + :: Interface a + -> Time + -> () + -> Effect a () +update iface (At time) m = m <# do + consoleLog $ toMisoString $ show time + + return $ (passAction iface) NoAction + +update iface (SlideInput time) m = m <# do + consoleLog $ "Input: " <> time + + return $ (passAction iface) NoAction + +update iface (SlideChange time) m = m <# do + consoleLog $ "Change: " <> time + + return $ (passAction iface) NoAction + +update _ _ m = noEff m diff --git a/src/Main.hs b/src/Main.hs index 80d3f7d..d802233 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -46,6 +46,7 @@ import Network.CatalogPostType (CatalogPost) import qualified Network.CatalogPostType as CatalogPost import qualified Component.CatalogGrid as Grid import qualified Component.ThreadView as Thread +import qualified Component.TimeControl as TC data Model = Model @@ -144,6 +145,7 @@ mainView model = view catalog_view :: Model -> View Action catalog_view _ = div_ [] [ h1_ [] [ text "Overboard Catalog" ] + , TC.view iTime , Grid.view iGrid (grid_model model) ] @@ -203,8 +205,8 @@ mainUpdate (GetThread GetThreadArgs {..}) m = m <# do show board_thread_id } -mainUpdate (ChangeURI old_uri) m = m { current_uri = old_uri } <# do - consoleLog $ "ChangeURI! " `append` (pack $ show $ old_uri) +mainUpdate (ChangeURI uri) m = m { current_uri = uri } <# do + consoleLog $ "ChangeURI! " `append` (pack $ show $ uri) return NoAction mainUpdate (GridAction ga) m = @@ -222,6 +224,10 @@ mainUpdate (ThreadAction ta) model = do noEff model { thread_model = tm } +mainUpdate (TimeAction ta) m = + TC.update iTime ta () + >> noEff m + iGrid :: Grid.Interface Action iGrid = Grid.Interface @@ -246,6 +252,9 @@ iClient action = Client.Interface iThread :: Thread.Interface Action iThread = Thread.Interface { Thread.passAction = ThreadAction } +iTime :: TC.Interface Action +iTime = TC.Interface { TC.passAction = TimeAction } + {- - TODO: - - Create the thread view