Make a better API for instantiating custom widgets.

src/Examples/boxtype.hs

@@ -25,7 +25,6 @@ bt n label' boxtype' square' = do
              (Width $ if square' then rowHeight - 20 else windowWidth - 20)
              (Height $ rowHeight - 20)))
           label'
-          Nothing
   setLabelsize b' (FontSize 11)
   when square' $ setAlign b' alignRight
 main :: IO ()

src/Examples/doublebuffer.hs

@@ -58,9 +58,8 @@ main = do
           (Size (Width 400) (Height 400))
           (Just (Position (X 10) (Y 10)))
           (Just "Single Window")
-          defaultCustomWidgetFuncs {
-            drawCustom = (Just $ (\w -> drawWindow sides' fst (safeCast w)))
-          }
+          (Just (\w -> drawWindow sides' fst (safeCast w)))
+          defaultCustomWidgetFuncs
           defaultCustomWindowFuncs
   setBox w1 FlatBox
   setColor w1 blackColor
@@ -80,9 +79,8 @@ main = do
           (Size (Width 400) (Height 400))
           (Just $ Position (X 10) (Y 10))
           (Just "Fl_Double_Window")
-          defaultCustomWidgetFuncs {
-                drawCustom = Just (\w -> drawWindow sides' snd (safeCast w))
-              }
+          (Just (\w -> drawWindow sides' snd (safeCast w)))
+          defaultCustomWidgetFuncs
           defaultCustomWindowFuncs
   setBox w2 FlatBox
   setColor w2 blackColor

src/Examples/nativefilechooser-simple-app.hs

@@ -68,7 +68,7 @@ initializeWindow w' = do
   _ <- add menu "&File/&Quit" (Just (KeySequence (ShortcutKeySequence [kb_CommandState] (NormalKeyType 'q')))) (Just quitCb) (MenuItemFlags [])
   w_w' <- getW w'
   w_h' <- getH w'
-  box' <- boxNew (toRectangle (20,25+20,w_w'-40,w_h'-40-25)) Nothing Nothing
+  box' <- boxNew (toRectangle (20,25+20,w_w'-40,w_h'-40-25)) Nothing
   setColor box' (Color 45)
   setBox box' FlatBox
   setAlign box' (Alignments [AlignTypeCenter, AlignTypeInside, AlignTypeWrap])

src/Examples/table-as-container.hs

@@ -100,10 +100,10 @@ main = do
   table <- tableCustom
             (toRectangle (20,20,win_w-40,win_h-40))
             (Just "FLTK widget table")
+            Nothing
+            drawCell
             defaultCustomWidgetFuncs
-            (defaultCustomTableFuncs{
-              drawCellCustom = (Just drawCell)
-              })
+            defaultCustomTableFuncs
   initializeTable table
   setTableSize table 50 50
   end win

src/Examples/table-simple.hs

@@ -66,10 +66,10 @@ main = do
                (Position (X 10) (Y 10))
                (Size (Width 880) (Height 380)))
              Nothing
+             Nothing
+             drawCell
              defaultCustomWidgetFuncs
-             defaultCustomTableFuncs {
-               drawCellCustom = (Just drawCell)
-             }
+             defaultCustomTableFuncs
   initializeTable table
   setResizable window (Just table)
   end window

src/Examples/table-sort.hs

@@ -218,10 +218,10 @@ main = do
                (Size (Width $ windowW - margin * 2)
                      (Height $ windowH - margin * 2)))
              Nothing
+             Nothing
+             (drawCell tableState)
              defaultCustomWidgetFuncs
-             (defaultCustomTableFuncs {
-                drawCellCustom = Just $ drawCell tableState
-             })
+             defaultCustomTableFuncs
   setColHeader table True
   setColResize table True
   setSelectionColor table yellowColor

src/Examples/table-spreadsheet-with-keyboard-nav.hs

@@ -241,10 +241,10 @@ main = do
   spreadsheet' <- tableCustom
                     (toRectangle (20,20,tableWidth', tableHeight'))
                     Nothing
+                    Nothing
+                    (drawCell props' intInput')
                     defaultCustomWidgetFuncs
-                    defaultCustomTableFuncs {
-                        drawCellCustom = (Just $ drawCell props' intInput')
-                      }
+                    defaultCustomTableFuncs
   whens' <- getWhen spreadsheet'
   setWhen spreadsheet' $ [WhenNotChanged] ++ whens'
   setSelection spreadsheet' 0 0 0 0

src/Examples/tile.hs

@@ -9,7 +9,7 @@ main = do
   setBox window NoBox
   _ <- setResizable window (Just window)
   tile <- tileNew (toRectangle (0,0,300,300)) Nothing
-  box0 <- boxNew (toRectangle (0,0,150,150)) (Just "0") Nothing
+  box0 <- boxNew (toRectangle (0,0,150,150)) (Just "0")
   setBox box0 DownBox
   setColor box0 (Color 9)
   setLabelsize box0 (FontSize 36)
@@ -18,33 +18,33 @@ main = do
   w1 <- doubleWindowNew (Size (Width 150) (Height 150)) (Just (Position (X 150) (Y 0))) Nothing
   begin w1
   setBox w1 NoBox
-  box1 <- boxNew (toRectangle (0,0,150,150)) (Just "1\nThis is a child window") Nothing
+  box1 <- boxNew (toRectangle (0,0,150,150)) (Just "1\nThis is a child window")
   setBox box1 DownBox
   setColor box1 (Color 19)
   setLabelsize box1 (FontSize 18)
   setAlign box1 (Alignments [AlignTypeClip, AlignTypeInside, AlignTypeWrap])
   _ <- setResizable w1 (Just box1)
   end w1
 
-  box2a <- boxNew (toRectangle (0,150,70,150)) (Just "2a") Nothing
+  box2a <- boxNew (toRectangle (0,150,70,150)) (Just "2a")
   setBox box2a DownBox
   setColor box2a (Color 12)
   setLabelsize box2a (FontSize 36)
   setAlign box2a (Alignments [AlignTypeClip])
 
-  box2b <- boxNew (toRectangle (70,150,80,150)) (Just "2b") Nothing
+  box2b <- boxNew (toRectangle (70,150,80,150)) (Just "2b")
   setBox box2b DownBox
   setColor box2b (Color 13)
   setLabelsize box2b (FontSize 36)
   setAlign box2b (Alignments [AlignTypeClip])
 
-  box3a <- boxNew (toRectangle (150,150,150,70)) (Just "3a") Nothing
+  box3a <- boxNew (toRectangle (150,150,150,70)) (Just "3a")
   setBox box3a DownBox
   setColor box3a (Color 12)
   setLabelsize box3a (FontSize 36)
   setAlign box3a (Alignments [AlignTypeClip])
 
-  box3b <- boxNew (toRectangle (150,(150+70),150,80)) (Just "3b") Nothing
+  box3b <- boxNew (toRectangle (150,(150+70),150,80)) (Just "3b")
   setBox box3b DownBox
   setColor box3b (Color 13)
   setLabelsize box3b (FontSize 36)
@@ -58,7 +58,7 @@ main = do
   tileY <- getY tile
   tileW <- getW tile
   tileH <- getH tile
-  r <- boxNew (toRectangle ((tileX+dx), (tileY+dy), (tileW-(2*dx)), (tileH-(2*dy)))) Nothing Nothing
+  r <- boxNew (toRectangle ((tileX+dx), (tileY+dy), (tileW-(2*dx)), (tileH-(2*dy)))) Nothing
   _ <- setResizable tile (Just r)
   end tile
   end window

src/Fluid/Generate.hs

@@ -98,8 +98,6 @@ constructorG flClassName hsConstructor name posSize
     ["-- Fl_Table " ++ (maybe "" id name) ++ " " ++ (show posSize)]
   | flClassName == "MenuItem" || flClassName == "Submenu" =
     [(maybe "_ <- " (\n -> n ++ " <- ") name) ++ "menuItemNew"]
-  | flClassName == "Fl_Browser" || flClassName == "Fl_Box" =
-    [typicalConstructorG name posSize hsConstructor ++ " Nothing"]
   | flClassName == "Fl_Window" =
     let (x,y,w,h) = posSize in
     [(maybe "_ <- " (\n -> n ++ " <- ") name) ++

src/Graphics/UI/FLTK/LowLevel/Box.chs

@@ -4,7 +4,9 @@ module Graphics.UI.FLTK.LowLevel.Box
     (
      -- * Constructor
      boxNew,
-     boxNewWithBoxtype
+     boxNewWithBoxtype,
+     boxCustom,
+     boxCustomWithBoxtype
      -- * Hierarchy
      --
      -- $hierarchy
@@ -32,27 +34,49 @@ import Graphics.UI.FLTK.LowLevel.Widget
 {# fun Fl_OverriddenBox_New as overriddenBoxNew' { `Int',`Int',`Int',`Int', id `Ptr ()'} -> `Ptr ()' id #}
 {# fun Fl_Box_New_WithBoxtype as boxNewWithBoxtype' {cFromEnum `Boxtype',  `Int',`Int',`Int',`Int',unsafeToCString `String'} -> `Ptr ()' id #}
 {# fun Fl_OverriddenBox_New_WithBoxtype as overriddenBoxNewWithBoxtype' {cFromEnum `Boxtype',  `Int',`Int',`Int',`Int',unsafeToCString `String', id `Ptr ()'} -> `Ptr ()' id #}
-boxNew :: Rectangle -> Maybe String -> Maybe (CustomWidgetFuncs Box) -> IO (Ref Box)
-boxNew rectangle l' funcs' =
+boxCustom :: Rectangle ->                       -- ^ The bounds of this box
+             Maybe String ->                    -- ^ Optional label
+             Maybe (Ref Box -> IO ()) ->        -- ^ Optional custom box drawing function
+             Maybe (CustomWidgetFuncs Box) ->   -- ^ Optional widget overrides
+             IO (Ref Box)
+boxCustom rectangle l' draw' funcs' =
   widgetMaker
     rectangle
     l'
+    draw'
     funcs'
     boxNew'
     boxNewWithLabel'
     overriddenBoxNew'
     overriddenBoxNewWithLabel'
 
-boxNewWithBoxtype :: Boxtype -> Rectangle -> String -> Maybe (CustomWidgetFuncs Box) -> IO (Ref Box)
-boxNewWithBoxtype boxtype' rectangle' l' funcs' =
+boxCustomWithBoxtype :: Boxtype -> Rectangle -> String -> Maybe (Ref Box -> IO ()) -> Maybe (CustomWidgetFuncs Box) -> IO (Ref Box)
+boxCustomWithBoxtype boxtype' rectangle' l' draw' funcs' =
     let (x_pos, y_pos, width, height) = fromRectangle rectangle'
     in case funcs' of
         Just fs -> do
-          ptr <- customWidgetFunctionStruct fs
+          ptr <- customWidgetFunctionStruct draw' fs
           overriddenBoxNewWithBoxtype' boxtype' x_pos y_pos width height l' (castPtr ptr) >>= toRef
         Nothing ->
           boxNewWithBoxtype' boxtype' x_pos y_pos width height l' >>= toRef
 
+
+boxNew :: Rectangle -> Maybe String -> IO (Ref Box)
+boxNew rectangle l' =
+    let (x_pos, y_pos, width, height) = fromRectangle rectangle
+    in case l' of
+        Nothing -> boxNew' x_pos y_pos width height >>=
+                             toRef
+        Just l -> boxNewWithLabel' x_pos y_pos width height l >>=
+                             toRef
+
+boxNewWithBoxtype :: Boxtype -> Rectangle -> String -> IO (Ref Box)
+boxNewWithBoxtype boxtype' rectangle' l' =
+    let (x_pos, y_pos, width, height) = fromRectangle rectangle'
+    in
+    boxNewWithBoxtype' boxtype' x_pos y_pos width height l' >>=
+                             toRef
+
 {#fun Fl_Box_handle as boxHandle' { id `Ptr ()', id `CInt' } -> `Int' #}
 instance (impl ~ (Event -> IO Int)) => Op (Handle ()) Box orig impl where
   runOp _ _ box event = withRef box (\p -> boxHandle' p (fromIntegral . fromEnum $ event))
@@ -69,4 +93,4 @@ instance (impl ~ (Event -> IO Int)) => Op (Handle ()) Box orig impl where
 --  |
 --  v
 -- "Graphics.UI.FLTK.LowLevel.Box"
--- @
+-- @

src/Graphics/UI/FLTK/LowLevel/Browser.chs

@@ -4,6 +4,7 @@ module Graphics.UI.FLTK.LowLevel.Browser
     (
      -- * Constructor
      browserNew,
+     browserCustom
      -- * Hierarchy
      --
      -- $hierarchy
@@ -30,17 +31,28 @@ import Graphics.UI.FLTK.LowLevel.Widget
 {# fun Fl_Browser_New_WithLabel as browserNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String'} -> `Ptr ()' id #}
 {# fun Fl_OverriddenBrowser_New_WithLabel as overriddenBrowserNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String', id `Ptr ()'} -> `Ptr ()' id #}
 {# fun Fl_OverriddenBrowser_New as overriddenBrowserNew' { `Int',`Int',`Int',`Int', id `Ptr ()'} -> `Ptr ()' id #}
-browserNew :: Rectangle -> Maybe String -> Maybe (CustomWidgetFuncs Browser) -> IO (Ref Browser)
-browserNew rectangle l' funcs' =
+browserCustom :: Rectangle -> Maybe String -> Maybe (Ref Browser -> IO ()) -> Maybe (CustomWidgetFuncs Browser) -> IO (Ref Browser)
+browserCustom rectangle l' draw' funcs' =
   widgetMaker
     rectangle
     l'
+    draw'
     funcs'
     browserNew'
     browserNewWithLabel'
     overriddenBrowserNew'
     overriddenBrowserNewWithLabel'
 
+browserNew :: Rectangle -> Maybe String -> IO (Ref Browser)
+browserNew rectangle l' =
+    let (x_pos, y_pos, width, height) = fromRectangle rectangle
+    in case l' of
+        Nothing -> browserNew' x_pos y_pos width height >>=
+                             toRef
+        Just l -> browserNewWithLabel' x_pos y_pos width height l >>=
+                             toRef
+
+
 {#fun Fl_Browser_handle as browserHandle' { id `Ptr ()', id `CInt' } -> `Int' #}
 instance (impl ~ (Event -> IO Int)) => Op (Handle ()) Browser orig impl where
   runOp _ _ browser event = withRef browser (\p -> browserHandle' p (fromIntegral . fromEnum $ event))

src/Graphics/UI/FLTK/LowLevel/Button.chs

@@ -33,11 +33,16 @@ import Graphics.UI.FLTK.LowLevel.Hierarchy
 {# fun Fl_Button_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #}
 {# fun Fl_OverriddenButton_New_WithLabel as overriddenWidgetNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String', id `Ptr ()'} -> `Ptr ()' id #}
 {# fun Fl_OverriddenButton_New as overriddenWidgetNew' { `Int',`Int',`Int',`Int', id `Ptr ()'} -> `Ptr ()' id #}
-buttonCustom :: Rectangle -> Maybe String -> Maybe (CustomWidgetFuncs Button) -> IO (Ref Button)
-buttonCustom rectangle l' funcs' =
+buttonCustom :: Rectangle ->                         -- ^ The bounds of this button
+                Maybe String ->                      -- ^ The button label
+                Maybe (Ref Button -> IO ()) ->       -- ^ Optional custom drawing function
+                Maybe (CustomWidgetFuncs Button) ->  -- ^ Optional custom widget functions
+                IO (Ref Button)
+buttonCustom rectangle l' draw' funcs' =
   widgetMaker
     rectangle
     l'
+    draw'
     funcs'
     widgetNew'
     widgetNewWithLabel'
@@ -50,6 +55,7 @@ buttonNew rectangle l' =
     rectangle
     l'
     Nothing
+    Nothing
     widgetNew'
     widgetNewWithLabel'
     overriddenWidgetNew'

src/Graphics/UI/FLTK/LowLevel/DoubleWindow.chs

@@ -31,12 +31,19 @@ import C2HS hiding (cFromEnum, toBool,cToEnum)
 {# fun Fl_OverriddenDouble_Window_NewXY as overriddenWindowNewXY' {`Int',`Int', `Int', `Int', id `Ptr ()'} -> `Ptr ()' id #}
 {# fun Fl_OverriddenDouble_Window_NewXY_WithLabel as overriddenWindowNewXYWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String', id `Ptr ()'} -> `Ptr ()' id #}
 {# fun Fl_OverriddenDouble_Window_New_WithLabel as overriddenWindowNewWithLabel' { `Int',`Int', unsafeToCString `String', id `Ptr ()'} -> `Ptr ()' id #}
-doubleWindowCustom :: Size -> Maybe Position -> Maybe String -> CustomWidgetFuncs DoubleWindow -> CustomWindowFuncs DoubleWindow -> IO (Ref DoubleWindow)
-doubleWindowCustom size position title customWidgetFuncs' customWindowFuncs' =
+doubleWindowCustom :: Size ->                              -- ^ Size of this window
+                      Maybe Position ->                    -- ^ Optional position of this window
+                      Maybe String ->                      -- ^ Optional label
+                      Maybe (Ref DoubleWindow -> IO ()) -> -- ^ Optional table drawing routine
+                      CustomWidgetFuncs DoubleWindow ->    -- ^ Custom widget overrides
+                      CustomWindowFuncs DoubleWindow ->    -- ^ Custom window overrides
+                      IO (Ref DoubleWindow)
+doubleWindowCustom size position title draw' customWidgetFuncs' customWindowFuncs' =
   windowMaker
     size
     position
     title
+    draw'
     customWidgetFuncs'
     customWindowFuncs'
     overriddenWindowNew'
@@ -50,6 +57,7 @@ doubleWindowNew size position title =
     size
     position
     title
+    Nothing
     (defaultCustomWidgetFuncs :: CustomWidgetFuncs DoubleWindow)
     (defaultCustomWindowFuncs :: CustomWindowFuncs DoubleWindow)
     overriddenWindowNew'

src/Graphics/UI/FLTK/LowLevel/GlWindow.chs

@@ -31,17 +31,19 @@ import C2HS hiding (cFromEnum, toBool,cToEnum)
 {# fun Fl_OverriddenGl_Window_NewXY as overriddenWindowNewXY' {`Int',`Int', `Int', `Int', id `Ptr ()'} -> `Ptr ()' id #}
 {# fun Fl_OverriddenGl_Window_NewXY_WithLabel as overriddenWindowNewXYWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String', id `Ptr ()'} -> `Ptr ()' id #}
 {# fun Fl_OverriddenGl_Window_New_WithLabel as overriddenWindowNewWithLabel' { `Int',`Int', unsafeToCString `String', id `Ptr ()'} -> `Ptr ()' id #}
-glWindowCustom :: Size ->
-                  Maybe Position ->
-                  Maybe String ->
-                  CustomWidgetFuncs GlWindow ->
-                  CustomWindowFuncs GlWindow ->
+glWindowCustom :: Size ->                           -- ^ The size of this window
+                  Maybe Position ->                 -- ^ The position of this window
+                  Maybe String ->                   -- ^ The window label
+                  Maybe (Ref GlWindow -> IO ()) ->  -- ^ Optional custom drawing function
+                  CustomWidgetFuncs GlWindow ->     -- ^ other custom widget functions
+                  CustomWindowFuncs GlWindow ->     -- ^ Other custom window functions
                   IO (Ref GlWindow)
-glWindowCustom size position title customWidgetFuncs' customWindowFuncs' =
+glWindowCustom size position title draw' customWidgetFuncs' customWindowFuncs' =
   windowMaker
     size
     position
     title
+    draw'
     customWidgetFuncs'
     customWindowFuncs'
     overriddenWindowNew'
@@ -54,6 +56,7 @@ glWindowNew size position title =
     size
     position
     title
+    Nothing
     (defaultCustomWidgetFuncs :: CustomWidgetFuncs GlWindow)
     (defaultCustomWindowFuncs :: CustomWindowFuncs GlWindow)
     overriddenWindowNew'