diff --git a/fltkhs.cabal b/fltkhs.cabal --- a/fltkhs.cabal +++ b/fltkhs.cabal @@ -1,5 +1,5 @@ name : fltkhs -version : 0.7.0.3 +version : 0.7.0.4 synopsis : FLTK bindings description: Low level bindings for the FLTK GUI toolkit. For installation and quick start instruction please scroll all the way down to the README. license : MIT diff --git a/scripts/doc-parser.hs b/scripts/doc-parser.hs --- a/scripts/doc-parser.hs +++ b/scripts/doc-parser.hs @@ -218,16 +218,19 @@ Just _fs -> let namesOnly = map (\(_,_,nName,_) -> nName) _fs in - ( - filter - (\f -> - not (elem f namesOnly) - ) - hierarchyFs - , filter - (\n -> not (elem n hierarchyFs)) - namesOnly - ) + if (not $ all (\(_,_,_,w') -> w' == w) _fs) + then error (show w) + else + ( + filter + (\f -> + not (elem f namesOnly) + ) + hierarchyFs + , filter + (\n -> not (elem n hierarchyFs)) + namesOnly + ) return (w,omitted) ) funcs diff --git a/src/Graphics/UI/FLTK/LowLevel/Adjuster.chs b/src/Graphics/UI/FLTK/LowLevel/Adjuster.chs --- a/src/Graphics/UI/FLTK/LowLevel/Adjuster.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Adjuster.chs @@ -49,9 +49,13 @@ adjusterNew :: Rectangle -> Maybe T.Text -> IO (Ref Adjuster) adjusterNew rectangle l'= let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> adjusterNew' x_pos y_pos width height >>= toRef - Just l -> copyTextToCString l >>= \l' -> adjusterNewWithLabel' x_pos y_pos width height l' >>= toRef + in do + r <- case l' of + Nothing -> adjusterNew' x_pos y_pos width height >>= toRef + Just l -> copyTextToCString l >>= \l' -> adjusterNewWithLabel' x_pos y_pos width height l' >>= toRef + setFlag r WidgetFlagCopiedLabel + setFlag r WidgetFlagCopiedTooltip + return r {# fun Fl_Adjuster_Destroy as adjusterDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ (IO ())) => Op (Destroy ()) Adjuster orig impl where diff --git a/src/Graphics/UI/FLTK/LowLevel/FLTKHS.hs b/src/Graphics/UI/FLTK/LowLevel/FLTKHS.hs --- a/src/Graphics/UI/FLTK/LowLevel/FLTKHS.hs +++ b/src/Graphics/UI/FLTK/LowLevel/FLTKHS.hs @@ -293,7 +293,7 @@ -- These are all great projects and produce really nice UIs, but they all fail -- at least one of criterion listed under the __Goals__ section below. -- --- To my knowledge, as of the last quarter of 2018, no other package +-- To my knowledge, as of the first quarter of 2019, no other package -- in the Haskell ecosystem meets all those constraints. -- @@ -1113,22 +1113,15 @@ -- elements that derive from the C++ base class -- and the Haskell -- analog --- now allow Haskell --- to be passed at widget construction time that give Haskell +-- now allow Haskell +-- to be passed at widget construction time that give Haskell -- complete control on --- , --- . This means that the Haskell user +-- , +-- . This means that the Haskell user -- has complete control of the look and feel as well as the event loop. The --- demos are an example of drawing in Haskell. An example of taking over --- the event loop is an FLTKHS that --- the FLTKHS event loop with the +-- demos are an example of drawing in Haskell. An example of taking over +-- the event loop is an FLTKHS that +-- the FLTKHS event loop with the -- allowing native -- functional reactive programming. The sky is the limit! -- diff --git a/src/Graphics/UI/FLTK/LowLevel/Group.chs b/src/Graphics/UI/FLTK/LowLevel/Group.chs --- a/src/Graphics/UI/FLTK/LowLevel/Group.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Group.chs @@ -186,7 +186,7 @@ runOp _ _ group event = withRef group $ \groupPtr -> handleSuper' groupPtr (fromIntegral (fromEnum event)) >>= return . successOrUnknownEvent {# fun Fl_Group_resize as resize' { id `Ptr ()',`Int',`Int',`Int',`Int' } -> `()' supressWarningAboutRes #} -instance (impl ~ (Rectangle -> IO ())) => Op (Resize ()) TextDisplay orig impl where +instance (impl ~ (Rectangle -> IO ())) => Op (Resize ()) Group orig impl where runOp _ _ group rectangle = withRef group $ \groupPtr -> do let (x_pos,y_pos,w_pos,h_pos) = fromRectangle rectangle resize' groupPtr x_pos y_pos w_pos h_pos @@ -253,7 +253,7 @@ -- -- removeWidget:: ('Parent' a 'Widget') => 'Ref' 'Group' -> 'Ref' a -> 'IO' () -- --- resize :: 'Ref' 'TextDisplay' -> 'Rectangle' -> 'IO' () +-- resize :: 'Ref' 'Group' -> 'Rectangle' -> 'IO' () -- -- resizeSuper :: 'Ref' 'Group' -> 'Rectangle' -> 'IO' () -- diff --git a/src/Graphics/UI/FLTK/LowLevel/Hierarchy.hs b/src/Graphics/UI/FLTK/LowLevel/Hierarchy.hs --- a/src/Graphics/UI/FLTK/LowLevel/Hierarchy.hs +++ b/src/Graphics/UI/FLTK/LowLevel/Hierarchy.hs @@ -4634,7 +4634,7 @@ type MultiLabelFuncs = (WidgetLabel (MenuItemLabel - (()))) + ())) type instance Functions MultiLabel = MultiLabelFuncs MAKE_METHOD(WidgetLabel, widgetLabel) diff --git a/src/Graphics/UI/FLTK/LowLevel/TextDisplay.chs b/src/Graphics/UI/FLTK/LowLevel/TextDisplay.chs --- a/src/Graphics/UI/FLTK/LowLevel/TextDisplay.chs +++ b/src/Graphics/UI/FLTK/LowLevel/TextDisplay.chs @@ -100,9 +100,13 @@ textDisplayNew :: Rectangle -> Maybe T.Text -> IO (Ref TextDisplay) textDisplayNew rectangle l' = let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> textDisplayNew' x_pos y_pos width height >>= toRef - Just l -> copyTextToCString l >>= \l' -> textDisplayNewWithLabel' x_pos y_pos width height l' >>= toRef + in do + r <- case l' of + Nothing -> textDisplayNew' x_pos y_pos width height >>= toRef + Just l -> copyTextToCString l >>= \l' -> textDisplayNewWithLabel' x_pos y_pos width height l' >>= toRef + setFlag r WidgetFlagCopiedLabel + setFlag r WidgetFlagCopiedTooltip + return r {# fun Fl_Text_Display_Destroy as textDisplayDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ (IO ())) => Op (Destroy ()) TextDisplay orig impl where diff --git a/src/Graphics/UI/FLTK/LowLevel/TreePrefs.chs b/src/Graphics/UI/FLTK/LowLevel/TreePrefs.chs --- a/src/Graphics/UI/FLTK/LowLevel/TreePrefs.chs +++ b/src/Graphics/UI/FLTK/LowLevel/TreePrefs.chs @@ -174,28 +174,28 @@ instance (impl ~ (TreeSelect -> IO ())) => Op (SetSelectmode ()) TreePrefs orig impl where runOp _ _ tree_prefs val = withRef tree_prefs $ \tree_prefsPtr -> setSelectmode' tree_prefsPtr val {# fun Fl_Tree_Prefs_marginbottom as marginbottom' { id `Ptr ()' } -> `Int' #} -instance (impl ~ ( IO (Int)) ) => Op (GetMarginbottom ()) Tree orig impl where +instance (impl ~ ( IO (Int)) ) => Op (GetMarginbottom ()) TreePrefs orig impl where runOp _ _ tree = withRef tree $ \treePtr -> marginbottom' treePtr {# fun Fl_Tree_Prefs_set_marginbottom as setMarginbottom' { id `Ptr ()',`Int' } -> `()' #} -instance (impl ~ (Int -> IO ()) ) => Op (SetMarginbottom ()) Tree orig impl where +instance (impl ~ (Int -> IO ()) ) => Op (SetMarginbottom ()) TreePrefs orig impl where runOp _ _ tree val = withRef tree $ \treePtr -> setMarginbottom' treePtr val {# fun Fl_Tree_Prefs_widgetmarginleft as widgetmarginleft' { id `Ptr ()' } -> `Int' #} -instance (impl ~ ( IO (Int)) ) => Op (GetWidgetmarginleft ()) Tree orig impl where +instance (impl ~ ( IO (Int)) ) => Op (GetWidgetmarginleft ()) TreePrefs orig impl where runOp _ _ tree = withRef tree $ \treePtr -> widgetmarginleft' treePtr {# fun Fl_Tree_Prefs_set_widgetmarginleft as setWidgetmarginleft' { id `Ptr ()',`Int' } -> `()' #} -instance (impl ~ (Int -> IO ()) ) => Op (SetWidgetmarginleft ()) Tree orig impl where +instance (impl ~ (Int -> IO ()) ) => Op (SetWidgetmarginleft ()) TreePrefs orig impl where runOp _ _ tree val = withRef tree $ \treePtr -> setWidgetmarginleft' treePtr val {# fun Fl_Tree_Prefs_item_reselect_mode as item_reselect_mode' { id `Ptr ()' } -> `TreeItemReselectMode' cToEnum #} -instance (impl ~ ( IO (TreeItemReselectMode)) ) => Op (GetItemReselectMode ()) Tree orig impl where +instance (impl ~ ( IO (TreeItemReselectMode)) ) => Op (GetItemReselectMode ()) TreePrefs orig impl where runOp _ _ tree = withRef tree $ \treePtr -> item_reselect_mode' treePtr {# fun Fl_Tree_Prefs_set_item_reselect_mode as setItem_Reselect_Mode' { id `Ptr ()', cFromEnum `TreeItemReselectMode' } -> `()' #} -instance (impl ~ (TreeItemReselectMode -> IO ()) ) => Op (SetItemReselectMode ()) Tree orig impl where +instance (impl ~ (TreeItemReselectMode -> IO ()) ) => Op (SetItemReselectMode ()) TreePrefs orig impl where runOp _ _ tree val = withRef tree $ \treePtr -> setItem_Reselect_Mode' treePtr val {# fun Fl_Tree_Prefs_item_draw_mode as item_draw_mode' { id `Ptr ()' } -> `CInt'#} -instance (impl ~ ( IO ([TreeItemDrawMode])) ) => Op (GetItemDrawMode ()) Tree orig impl where +instance (impl ~ ( IO ([TreeItemDrawMode])) ) => Op (GetItemDrawMode ()) TreePrefs orig impl where runOp _ _ tree = withRef tree $ \treePtr -> item_draw_mode' treePtr >>= return . extract allTreeItemDrawModes {# fun Fl_Tree_Prefs_set_item_draw_mode as setItem_Draw_Mode' { id `Ptr ()', `CInt' } -> `()' #} -instance (impl ~ ([TreeItemDrawMode] -> IO ()) ) => Op (SetItemDrawMode ()) Tree orig impl where +instance (impl ~ ([TreeItemDrawMode] -> IO ()) ) => Op (SetItemDrawMode ()) TreePrefs orig impl where runOp _ _ tree val = withRef tree $ \treePtr -> setItem_Draw_Mode' treePtr (fromIntegral (combine val)) -- $functions @@ -208,7 +208,7 @@ -- -- getConnectorwidth :: 'Ref' 'TreePrefs' -> 'IO' ('Int') -- --- getItemDrawMode :: 'Ref' 'Tree' -> 'IO' (['TreeItemDrawMode')] +-- getItemDrawMode :: 'Ref' 'TreePrefs' -> 'IO' (['TreeItemDrawMode')] -- -- getItemLabelbgcolor :: 'Ref' 'TreePrefs' -> 'IO' ('Color') -- @@ -216,7 +216,7 @@ -- -- getItemLabelsize :: 'Ref' 'TreePrefs' -> 'IO' ('FontSize') -- --- getItemReselectMode :: 'Ref' 'Tree' -> 'IO' ('TreeItemReselectMode') +-- getItemReselectMode :: 'Ref' 'TreePrefs' -> 'IO' ('TreeItemReselectMode') -- -- getLabelbgcolor :: 'Ref' 'TreePrefs' -> 'IO' ('Color') -- @@ -230,7 +230,7 @@ -- -- getLinespacing :: 'Ref' 'TreePrefs' -> 'IO' ('Int') -- --- getMarginbottom :: 'Ref' 'Tree' -> 'IO' ('Int') +-- getMarginbottom :: 'Ref' 'TreePrefs' -> 'IO' ('Int') -- -- getMarginleft :: 'Ref' 'TreePrefs' -> 'IO' ('Int') -- @@ -254,7 +254,7 @@ -- -- getUsericonmarginleft :: 'Ref' 'TreePrefs' -> 'IO' ('Int') -- --- getWidgetmarginleft :: 'Ref' 'Tree' -> 'IO' ('Int') +-- getWidgetmarginleft :: 'Ref' 'TreePrefs' -> 'IO' ('Int') -- -- setCloseicon:: ('Parent' a 'Image') => 'Ref' 'TreePrefs' -> 'Maybe' ( 'Ref' a ) -> 'IO' () -- @@ -264,7 +264,7 @@ -- -- setConnectorwidth :: 'Ref' 'TreePrefs' -> 'Int' -> 'IO' () -- --- setItemDrawMode :: 'Ref' 'Tree' -> ['TreeItemDrawMode'] -> 'IO' () +-- setItemDrawMode :: 'Ref' 'TreePrefs' -> ['TreeItemDrawMode'] -> 'IO' () -- -- setItemLabelbgcolor :: 'Ref' 'TreePrefs' -> 'Color' -> 'IO' () -- @@ -274,7 +274,7 @@ -- -- setItemLabelsize :: 'Ref' 'TreePrefs' -> 'FontSize' -> 'IO' () -- --- setItemReselectMode :: 'Ref' 'Tree' -> 'TreeItemReselectMode' -> 'IO' () +-- setItemReselectMode :: 'Ref' 'TreePrefs' -> 'TreeItemReselectMode' -> 'IO' () -- -- setLabelbgcolor :: 'Ref' 'TreePrefs' -> 'Color' -> 'IO' () -- @@ -288,7 +288,7 @@ -- -- setLinespacing :: 'Ref' 'TreePrefs' -> 'Int' -> 'IO' () -- --- setMarginbottom :: 'Ref' 'Tree' -> 'Int' -> 'IO' () +-- setMarginbottom :: 'Ref' 'TreePrefs' -> 'Int' -> 'IO' () -- -- setMarginleft :: 'Ref' 'TreePrefs' -> 'Int' -> 'IO' () -- @@ -312,7 +312,7 @@ -- -- setUsericonmarginleft :: 'Ref' 'TreePrefs' -> 'Int' -> 'IO' () -- --- setWidgetmarginleft :: 'Ref' 'Tree' -> 'Int' -> 'IO' () +-- setWidgetmarginleft :: 'Ref' 'TreePrefs' -> 'Int' -> 'IO' () -- @ -- $hierarchy