0
/
chandler-miso
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add input range time control 

- add component module
- hook up events, update function etc
This commit is contained in:
towards-a-new-leftypol 2024-02-19 13:02:16 -05:00
parent 0345a755a4
commit 49157c27f2
10 changed files with 185 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
chandlr.cabal
View File

@ -82,6 +82,7 @@ executable chandlr
BodyParser BodyParser
QuoteLinkParser QuoteLinkParser
PostPartType PostPartType
Component.TimeControl
-- LANGUAGE extensions used by modules in this package. -- LANGUAGE extensions used by modules in this package.

5
html/README.hs Normal file
View File

@ -0,0 +1,5 @@
You can use these snippets to generate Miso view syntax
```bash
cat timecontrol.html | miso-from-html
```

16
html/scroll.js Normal file
View File

@ -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();
}

19
html/scrollbar.html Normal file
View File

@ -0,0 +1,19 @@
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="UTF-8">
<title>Scrollbar demo</title>
<link href="tc.css" rel="stylesheet" />
<script language="javascript" src="scroll.js"></script>
</head>
<body>
<div class="timecontrol">
<div class="tc-scrollbar__wrapper">
<div class="tc-scrollbar__bar">
<div class="tc-scrollbar__scroller"></div>
</div>
</div>
</div>
<input class="time-control" type="range" min=-500 max=0 step=1 value=0>
</body>
</html>

43
html/tc.css Normal file
View File

@ -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;
}

1
html/timecontrol.html Normal file
View File

@ -0,0 +1 @@
<input class="time-control" type="range" min="-500" max="0" step="1" value="0">

7
index.html
View File

@ -15,6 +15,13 @@
.post.reply.multifile .body { .post.reply.multifile .body {
clear: both; clear: both;
} }
.time-slider {
width: 70%;
margin-left: auto;
margin-right: auto;
display: block;
}
</style> </style>
</head> </head>
<body> <body>

3
src/Action.hs
View File

@ -13,6 +13,8 @@ import Network.CatalogPostType (CatalogPost)
import Network.Http (HttpResult) import Network.Http (HttpResult)
import Network.SiteType (Site) import Network.SiteType (Site)
import qualified Component.ThreadView as Thread import qualified Component.ThreadView as Thread
import qualified Component.ThreadView as Thread
import qualified Component.TimeControl as TC
data GetThreadArgs = GetThreadArgs data GetThreadArgs = GetThreadArgs
{ website :: Text { website :: Text
@ -28,5 +30,6 @@ data Action
| HaveThread (HttpResult [ Site ]) | HaveThread (HttpResult [ Site ])
| forall a. (FromJSON a) => ClientAction (HttpResult a -> Action) (C.Action a) | forall a. (FromJSON a) => ClientAction (HttpResult a -> Action) (C.Action a)
| ThreadAction Thread.Action | ThreadAction Thread.Action
| TimeAction TC.Time
| ChangeURI URI | ChangeURI URI
| NoAction | NoAction

79
src/Component/TimeControl.hs Normal file
View File

@ -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

13
src/Main.hs
View File

@ -46,6 +46,7 @@ import Network.CatalogPostType (CatalogPost)
import qualified Network.CatalogPostType as CatalogPost import qualified Network.CatalogPostType as CatalogPost
import qualified Component.CatalogGrid as Grid import qualified Component.CatalogGrid as Grid
import qualified Component.ThreadView as Thread import qualified Component.ThreadView as Thread
import qualified Component.TimeControl as TC
data Model = Model data Model = Model
@ -144,6 +145,7 @@ mainView model = view
catalog_view :: Model -> View Action catalog_view :: Model -> View Action
catalog_view _ = div_ [] catalog_view _ = div_ []
[ h1_ [] [ text "Overboard Catalog" ] [ h1_ [] [ text "Overboard Catalog" ]
, TC.view iTime
, Grid.view iGrid (grid_model model) , Grid.view iGrid (grid_model model)
] ]
@ -203,8 +205,8 @@ mainUpdate (GetThread GetThreadArgs {..}) m = m <# do
</> show board_thread_id </> show board_thread_id
} }
mainUpdate (ChangeURI old_uri) m = m { current_uri = old_uri } <# do mainUpdate (ChangeURI uri) m = m { current_uri = uri } <# do
consoleLog $ "ChangeURI! " `append` (pack $ show $ old_uri) consoleLog $ "ChangeURI! " `append` (pack $ show $ uri)
return NoAction return NoAction
mainUpdate (GridAction ga) m = mainUpdate (GridAction ga) m =
@ -222,6 +224,10 @@ mainUpdate (ThreadAction ta) model = do
noEff model { thread_model = tm } noEff model { thread_model = tm }
mainUpdate (TimeAction ta) m =
TC.update iTime ta ()
>> noEff m
iGrid :: Grid.Interface Action iGrid :: Grid.Interface Action
iGrid = Grid.Interface iGrid = Grid.Interface
@ -246,6 +252,9 @@ iClient action = Client.Interface
iThread :: Thread.Interface Action iThread :: Thread.Interface Action
iThread = Thread.Interface { Thread.passAction = ThreadAction } iThread = Thread.Interface { Thread.passAction = ThreadAction }
iTime :: TC.Interface Action
iTime = TC.Interface { TC.passAction = TimeAction }
{- {-
- TODO: - TODO:
- - Create the thread view - - Create the thread view