Commit 97d1719b authored by David Davó's avatar David Davó

Updated SelectionContainer widgets

parent 74e36155
...@@ -51,8 +51,11 @@ mkAccordion = do ...@@ -51,8 +51,11 @@ mkAccordion = do
instance IHaskellWidget Accordion where instance IHaskellWidget Accordion where
getCommUUID = uuid getCommUUID = uuid
comm widget val _ = comm widget val _ =
case nestedObjectLookup val ["sync_data", "selected_index"] of case nestedObjectLookup val ["state", "selected_index"] of
Just (Number num) -> do Just (Number num) -> do
void $ setField' widget SelectedIndex (Sci.coefficient num) void $ setField' widget SelectedIndex $ Just (Sci.coefficient num)
triggerChange widget
Just Null -> do
void $ setField' widget SelectedIndex Nothing
triggerChange widget triggerChange widget
_ -> pure () _ -> pure ()
...@@ -15,6 +15,8 @@ module IHaskell.Display.Widgets.Box.SelectionContainer.Tab ...@@ -15,6 +15,8 @@ module IHaskell.Display.Widgets.Box.SelectionContainer.Tab
-- To keep `cabal repl` happy when running from the ihaskell repo -- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude import Prelude
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
...@@ -50,8 +52,11 @@ mkTabWidget = do ...@@ -50,8 +52,11 @@ mkTabWidget = do
instance IHaskellWidget TabWidget where instance IHaskellWidget TabWidget where
getCommUUID = uuid getCommUUID = uuid
comm widget val _ = comm widget val _ =
case nestedObjectLookup val ["sync_data", "selected_index"] of case nestedObjectLookup val ["state", "selected_index"] of
Just (Number num) -> do Just (Number num) -> do
_ <- setField' widget SelectedIndex (Sci.coefficient num) void $ setField' widget SelectedIndex $ Just (Sci.coefficient num)
triggerChange widget
Just Null -> do
void $ setField' widget SelectedIndex Nothing
triggerChange widget triggerChange widget
_ -> pure () _ -> pure ()
...@@ -227,7 +227,7 @@ type family FieldType (f :: Field) :: * where ...@@ -227,7 +227,7 @@ type family FieldType (f :: Field) :: * where
FieldType 'S.Pack = LocationValue FieldType 'S.Pack = LocationValue
FieldType 'S.Align = LocationValue FieldType 'S.Align = LocationValue
FieldType 'S.Titles = [Text] FieldType 'S.Titles = [Text]
FieldType 'S.SelectedIndex = Integer FieldType 'S.SelectedIndex = Maybe Integer
FieldType 'S.ReadOutMsg = Text FieldType 'S.ReadOutMsg = Text
FieldType 'S.Indent = Bool FieldType 'S.Indent = Bool
FieldType 'S.Child = Maybe ChildWidget FieldType 'S.Child = Maybe ChildWidget
...@@ -327,6 +327,7 @@ data WidgetType = ButtonType ...@@ -327,6 +327,7 @@ data WidgetType = ButtonType
| VBoxType | VBoxType
| AccordionType | AccordionType
| TabType | TabType
| StackedType
| ControllerButtonType | ControllerButtonType
| ControllerAxisType | ControllerAxisType
| ControllerType | ControllerType
...@@ -409,6 +410,7 @@ type family WidgetFields (w :: WidgetType) :: [Field] where ...@@ -409,6 +410,7 @@ type family WidgetFields (w :: WidgetType) :: [Field] where
WidgetFields 'VBoxType = BoxClass WidgetFields 'VBoxType = BoxClass
WidgetFields 'AccordionType = SelectionContainerClass WidgetFields 'AccordionType = SelectionContainerClass
WidgetFields 'TabType = SelectionContainerClass WidgetFields 'TabType = SelectionContainerClass
WidgetFields 'StackedType = SelectionContainerClass
WidgetFields 'ControllerType = WidgetFields 'ControllerType =
CoreWidgetClass :++ DOMWidgetClass :++ CoreWidgetClass :++ DOMWidgetClass :++
['S.Index, 'S.Name, 'S.Mapping, 'S.Connected, 'S.Timestamp, 'S.Buttons, 'S.Axes, 'S.ChangeHandler ] ['S.Index, 'S.Name, 'S.Mapping, 'S.Connected, 'S.Timestamp, 'S.Buttons, 'S.Axes, 'S.ChangeHandler ]
...@@ -924,7 +926,7 @@ defaultSelectionContainerWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelNa ...@@ -924,7 +926,7 @@ defaultSelectionContainerWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelNa
defaultSelectionContainerWidget viewName modelName = defaultBoxWidget viewName modelName <+> selAttrs defaultSelectionContainerWidget viewName modelName = defaultBoxWidget viewName modelName <+> selAttrs
where where
selAttrs = (Titles =:: []) selAttrs = (Titles =:: [])
:& (SelectedIndex =:: 0) :& (SelectedIndex =:: Nothing)
:& (ChangeHandler =:: return ()) :& (ChangeHandler =:: return ())
:& 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