Add input range time control
- add component module - hook up events, update function etc
This commit is contained in:
parent
0345a755a4
commit
49157c27f2
|
|
@ -82,6 +82,7 @@ executable chandlr
|
|||
BodyParser
|
||||
QuoteLinkParser
|
||||
PostPartType
|
||||
Component.TimeControl
|
||||
|
||||
|
||||
-- LANGUAGE extensions used by modules in this package.
|
||||
|
|
|
|||
|
|
@ -0,0 +1,5 @@
|
|||
You can use these snippets to generate Miso view syntax
|
||||
|
||||
```bash
|
||||
cat timecontrol.html | miso-from-html
|
||||
```
|
||||
|
|
@ -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();
|
||||
}
|
||||
|
|
@ -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>
|
||||
|
|
@ -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;
|
||||
}
|
||||
|
|
@ -0,0 +1 @@
|
|||
<input class="time-control" type="range" min="-500" max="0" step="1" value="0">
|
||||
|
|
@ -15,6 +15,13 @@
|
|||
.post.reply.multifile .body {
|
||||
clear: both;
|
||||
}
|
||||
|
||||
.time-slider {
|
||||
width: 70%;
|
||||
margin-left: auto;
|
||||
margin-right: auto;
|
||||
display: block;
|
||||
}
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
13
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
|
||||
|
|
|
|||
Loading…
Reference in New Issue