Commit 792ac0ef authored by David Davó's avatar David Davó

Update Numeric Widgets example

parent 7e20685c
...@@ -5,3 +5,12 @@ IHaskell. The frontend (javascript) is provided by the jupyter/ipython notebook ...@@ -5,3 +5,12 @@ IHaskell. The frontend (javascript) is provided by the jupyter/ipython notebook
the backend is implemented in haskell. the backend is implemented in haskell.
To know more about the widget messaging protocol, see [MsgSpec.md](MsgSpec.md). To know more about the widget messaging protocol, see [MsgSpec.md](MsgSpec.md).
## Contributing examples
If you want to contribute with more Notebook examples, please do so on the `Examples/`
folder. Before commiting, please make sure they can be executed sequentialy and
then remove the output from the Nootebooks with:
```bash
jupyter nbconvert *.ipynb --to notebook --inplace --clear-output
```
\ No newline at end of file
...@@ -19,7 +19,7 @@ import Control.Monad (void) ...@@ -19,7 +19,7 @@ import Control.Monad (void)
import Data.Aeson import Data.Aeson
import Data.IORef (newIORef) import Data.IORef (newIORef)
import qualified Data.Scientific as Sci import qualified Data.Scientific as Sci
import Data.Vinyl (Rec(..), (<+>)) import Data.Vinyl (Rec(..), (<+>), rput)
import IHaskell.Display import IHaskell.Display
import IHaskell.Eval.Widgets import IHaskell.Eval.Widgets
...@@ -44,7 +44,8 @@ mkFloatLogSlider = do ...@@ -44,7 +44,8 @@ mkFloatLogSlider = do
:& (SliderColor =:: "") :& (SliderColor =:: "")
:& (BaseFloat =:: 10.0) :& (BaseFloat =:: 10.0)
:& RNil :& RNil
widgetState = WidgetState $ boundedFloatAttrs <+> sliderAttrs widgetState = WidgetState $ rput (MaxFloat =:: 4.0)
$ boundedFloatAttrs <+> sliderAttrs
stateIO <- newIORef widgetState stateIO <- newIORef widgetState
......
...@@ -19,6 +19,7 @@ import Control.Monad (void) ...@@ -19,6 +19,7 @@ import Control.Monad (void)
import Data.Aeson import Data.Aeson
import Data.IORef (newIORef) import Data.IORef (newIORef)
import qualified Data.Scientific as Sci import qualified Data.Scientific as Sci
import Data.Vinyl (Rec(..), (<+>))
import IHaskell.Display import IHaskell.Display
import IHaskell.Eval.Widgets import IHaskell.Eval.Widgets
...@@ -36,7 +37,10 @@ mkFloatText = do ...@@ -36,7 +37,10 @@ mkFloatText = do
-- Default properties, with a random uuid -- Default properties, with a random uuid
wid <- U.random wid <- U.random
let widgetState = WidgetState $ defaultFloatWidget "FloatTextView" "FloatTextModel" let floatAttrs = defaultFloatWidget "FloatTextView" "FloatTextModel"
textAttrs = (StepFloat =:+ 0.1)
:& RNil
widgetState = WidgetState $ floatAttrs <+> textAttrs
stateIO <- newIORef widgetState stateIO <- newIORef widgetState
......
...@@ -19,6 +19,7 @@ import Control.Monad (void) ...@@ -19,6 +19,7 @@ import Control.Monad (void)
import Data.Aeson import Data.Aeson
import Data.IORef (newIORef) import Data.IORef (newIORef)
import qualified Data.Scientific as Sci import qualified Data.Scientific as Sci
import Data.Vinyl (Rec(..), (<+>))
import IHaskell.Display import IHaskell.Display
import IHaskell.Eval.Widgets import IHaskell.Eval.Widgets
...@@ -36,7 +37,10 @@ mkIntText = do ...@@ -36,7 +37,10 @@ mkIntText = do
-- Default properties, with a random uuid -- Default properties, with a random uuid
wid <- U.random wid <- U.random
let widgetState = WidgetState $ defaultIntWidget "IntTextView" "IntTextModel" let intAttrs = defaultIntWidget "IntTextView" "IntTextModel"
textAttrs = (StepInt =:+ 1)
:& RNil
widgetState = WidgetState $ intAttrs <+> textAttrs
stateIO <- newIORef widgetState stateIO <- newIORef widgetState
......
...@@ -334,7 +334,7 @@ type family WidgetFields (w :: WidgetType) :: [Field] where ...@@ -334,7 +334,7 @@ type family WidgetFields (w :: WidgetType) :: [Field] where
WidgetFields 'ToggleButtonsType = WidgetFields 'ToggleButtonsType =
SelectionClass :++ ['S.Tooltips, 'S.Icons, 'S.ButtonStyle] SelectionClass :++ ['S.Tooltips, 'S.Icons, 'S.ButtonStyle]
WidgetFields 'SelectMultipleType = MultipleSelectionClass WidgetFields 'SelectMultipleType = MultipleSelectionClass
WidgetFields 'IntTextType = IntClass WidgetFields 'IntTextType = IntClass :++ '[ 'S.StepInt ]
WidgetFields 'BoundedIntTextType = BoundedIntClass WidgetFields 'BoundedIntTextType = BoundedIntClass
WidgetFields 'IntSliderType = WidgetFields 'IntSliderType =
BoundedIntClass :++ BoundedIntClass :++
...@@ -344,7 +344,7 @@ type family WidgetFields (w :: WidgetType) :: [Field] where ...@@ -344,7 +344,7 @@ type family WidgetFields (w :: WidgetType) :: [Field] where
WidgetFields 'IntRangeSliderType = WidgetFields 'IntRangeSliderType =
BoundedIntRangeClass :++ BoundedIntRangeClass :++
['S.Orientation, 'S.ShowRange, 'S.ReadOut, 'S.SliderColor] ['S.Orientation, 'S.ShowRange, 'S.ReadOut, 'S.SliderColor]
WidgetFields 'FloatTextType = FloatClass WidgetFields 'FloatTextType = FloatClass :++ '[ 'S.StepFloat ]
WidgetFields 'BoundedFloatTextType = BoundedFloatClass WidgetFields 'BoundedFloatTextType = BoundedFloatClass
WidgetFields 'FloatSliderType = WidgetFields 'FloatSliderType =
BoundedFloatClass :++ BoundedFloatClass :++
...@@ -784,7 +784,7 @@ defaultFloatWidget viewName modelName = defaultDOMWidget viewName modelName <+> ...@@ -784,7 +784,7 @@ defaultFloatWidget viewName modelName = defaultDOMWidget viewName modelName <+>
defaultBoundedFloatWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelName -> Rec Attr BoundedFloatClass defaultBoundedFloatWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelName -> Rec Attr BoundedFloatClass
defaultBoundedFloatWidget viewName modelName = defaultFloatWidget viewName modelName <+> boundedFloatAttrs defaultBoundedFloatWidget viewName modelName = defaultFloatWidget viewName modelName <+> boundedFloatAttrs
where where
boundedFloatAttrs = (StepFloat =:+ 1) boundedFloatAttrs = (StepFloat =:+ 0.1)
:& (MinFloat =:: 0) :& (MinFloat =:: 0)
:& (MaxFloat =:: 100) :& (MaxFloat =:: 100)
:& RNil :& RNil
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment