fltkhs-themes 0.1.0.7 → 0.2.0.0
raw patch · 14 files changed
+102/−73 lines, 14 filesdep ~fltkhs
Dependency ranges changed: fltkhs
Files
- fltkhs-themes.cabal +5/−6
- src/Graphics/UI/FLTK/Theme/Light/Browser.hs +5/−5
- src/Graphics/UI/FLTK/Theme/Light/Button.hs +20/−12
- src/Graphics/UI/FLTK/Theme/Light/ColorChooser.hs +8/−2
- src/Graphics/UI/FLTK/Theme/Light/Common.hs +14/−11
- src/Graphics/UI/FLTK/Theme/Light/Counter.hs +2/−1
- src/Graphics/UI/FLTK/Theme/Light/Input.hs +4/−4
- src/Graphics/UI/FLTK/Theme/Light/Menu.hs +3/−2
- src/Graphics/UI/FLTK/Theme/Light/Positioner.hs +2/−1
- src/Graphics/UI/FLTK/Theme/Light/Slider.hs +17/−10
- src/Graphics/UI/FLTK/Theme/Light/Spinner.hs +4/−4
- src/Graphics/UI/FLTK/Theme/Light/Tabs.hs +13/−12
- src/Graphics/UI/FLTK/Theme/Light/Tree.hs +2/−1
- src/Graphics/UI/FLTK/Theme/Light/Valuator.hs +3/−2
fltkhs-themes.cabal view
@@ -1,13 +1,11 @@-cabal-version: 1.24---- This file has been generated from package.yaml by hpack version 0.31.1.+-- This file has been generated from package.yaml by hpack version 0.28.2. -- -- see: https://github.com/sol/hpack ----- hash: 9d37c0743e1b91bd5c46b144c5b33aa83c94e0ca50eee662d4a8b2e961702eeb+-- hash: 140888cae25937b0d1dc097459ba0ba8669ee46293f6a1087be31c19f814b6b3 name: fltkhs-themes-version: 0.1.0.7+version: 0.2.0.0 synopsis: A set of themed widgets that provides drop in replacements to the ones in FLTKHS. description: Please see the README on Github at <https://github.com/deech/fltkhs-themes#readme> category: UI,Graphics,GUI,User Interfaces@@ -19,6 +17,7 @@ license: BSD3 license-file: LICENSE build-type: Custom+cabal-version: >= 1.24 extra-source-files: README.org extra-doc-files:@@ -95,7 +94,7 @@ build-depends: base >=4.7 && <5 , bytestring- , fltkhs >=0.7.0.4+ , fltkhs >=0.8.0.0 , load-font >=0.1.0.2 , text >=1.2.2.0 , vector >=0.12.0.1
src/Graphics/UI/FLTK/Theme/Light/Browser.hs view
@@ -17,7 +17,7 @@ import Graphics.UI.FLTK.Theme.Light.Assets -- | The custom 'draw' function for creating the themed browser-browserDraw :: Ref LowLevel.Browser -> IO ()+browserDraw :: Ref LowLevel.BrowserBase -> IO () browserDraw b = do (color :: Color) <- LowLevel.getColor b let slightlyDarker = colorAverage color blackColor 0.85@@ -26,10 +26,10 @@ (\rect _ -> do LowLevel.flcRectfWithColor rect color LowLevel.flcRectWithColor rect slightlyDarker)- (LowLevel.drawSuper b)+ (LowLevel.drawBrowserBase (safeCast b)) -- | Setting the theme's color, fonts etc-browserSetup :: (?assets :: Assets) => Ref LowLevel.Browser -> IO ()+browserSetup :: (?assets :: Assets) => Ref LowLevel.BrowserBase -> IO () browserSetup b = do LowLevel.setColor b lightBackground LowLevel.setBox b BorderBox@@ -43,8 +43,8 @@ browserNew :: (?assets :: Assets) => Rectangle -> Maybe T.Text -> IO (Ref LowLevel.Browser) browserNew rect l = do- b <- LowLevel.browserCustom rect l (Just browserDraw) Nothing- browserSetup b+ b <- LowLevel.browserCustom rect l (Just (browserDraw . safeCast)) Nothing+ browserSetup (safeCast b) return b selectBrowserNew :: (?assets :: Assets) => Rectangle -> Maybe T.Text -> IO (Ref LowLevel.SelectBrowser)
src/Graphics/UI/FLTK/Theme/Light/Button.hs view
@@ -35,9 +35,10 @@ import qualified Graphics.UI.FLTK.LowLevel.FL as FL import qualified Graphics.UI.FLTK.LowLevel.FLTKHS as LowLevel import Graphics.UI.FLTK.Theme.Light.Assets+import Data.List -- | Check of the given button is 'HiddenButtonType'-buttonIsHidden :: Ref LowLevel.Button -> IO Bool+buttonIsHidden :: Ref LowLevel.ButtonBase -> IO Bool buttonIsHidden b = do t <- LowLevel.getType_ b case t of@@ -45,7 +46,7 @@ _ -> return False -- | Draw a regular button, i.e not a radio button, toggle button, etc.-drawRegularButton :: FillSpec -> Ref LowLevel.Button -> IO ()+drawRegularButton :: FillSpec -> Ref LowLevel.ButtonBase -> IO () drawRegularButton spec b = do buttonType <- LowLevel.getType_ b case buttonType of@@ -64,7 +65,7 @@ -- label so the indicator can properly position itself next to the label and the widget itself. drawIndicatorButton :: (- Parent orig LowLevel.Widget,+ Parent orig LowLevel.WidgetBase, Match b ~ FindOp orig orig (LowLevel.ActiveR ()), Op (LowLevel.ActiveR ()) b orig (IO Bool), Match c ~ FindOp orig orig (LowLevel.GetAlign ()),@@ -84,7 +85,7 @@ Match k ~ FindOp orig orig (LowLevel.GetBox ()), Op (LowLevel.GetBox ()) k orig (IO (Boxtype)), Match l ~ FindOp orig orig (LowLevel.GetParent ()),- Op (LowLevel.GetParent ()) l orig (IO (Maybe (Ref LowLevel.Group))),+ Op (LowLevel.GetParent ()) l orig (IO (Maybe (Ref LowLevel.GroupBase))), Match m ~ FindOp orig orig (LowLevel.GetColor ()), Op (LowLevel.GetColor ()) m orig (IO (Color)), Match n ~ FindOp orig orig (LowLevel.SetColor ()),@@ -107,7 +108,7 @@ else do maybeParent <- LowLevel.getParent b case maybeParent of- Just (p :: Ref LowLevel.Group) -> do+ Just (p :: Ref LowLevel.GroupBase) -> do c <- LowLevel.getColor p () <- LowLevel.setColor b c focused <- isWidget b FL.focus@@ -294,6 +295,13 @@ () <- LowLevel.setLabelsize b commonFontSize LowLevel.setAlign b (Alignments [AlignTypeInside, AlignTypeCenter , AlignTypeImageNextToText]) +handleButtonHover :: Ref LowLevel.ButtonBase -> Event -> IO (Either UnknownEvent ())+handleButtonHover b e = do+ res <- handleHover b e+ case res of+ Left _ -> LowLevel.handleButtonBase b e+ Right _ -> return (Right ())+ buttonNew :: (?assets :: Assets) => Rectangle -> Maybe T.Text -> IO (Ref LowLevel.Button) buttonNew rectangle label = do b <- LowLevel.buttonCustom@@ -301,8 +309,8 @@ label (Just (\b -> do spec <- buttonFillSpec b- drawRegularButton spec b))- (Just (LowLevel.defaultCustomWidgetFuncs { LowLevel.handleCustom = Just handleHover }))+ drawRegularButton spec (safeCast b)))+ (Just (LowLevel.defaultCustomWidgetFuncs { LowLevel.handleCustom = Just (handleButtonHover . safeCast) })) buttonSetup b return b @@ -313,8 +321,8 @@ label (Just (\b -> do spec <- buttonFillSpec b- drawRegularButton spec b))- (Just (LowLevel.defaultCustomWidgetFuncs { LowLevel.handleCustom = (Just handleHover ) }))+ drawRegularButton spec (safeCast b)))+ (Just (LowLevel.defaultCustomWidgetFuncs { LowLevel.handleCustom = Just (handleButtonHover . safeCast ) })) LowLevel.setType b ToggleButtonType buttonSetup b return (LowLevel.castTo b)@@ -329,7 +337,7 @@ hidden <- buttonIsHidden (safeCast b) fontSize <- LowLevel.getLabelsize b drawIndicatorButton drawLight pressed False hidden fontSize b))- (Just (LowLevel.defaultCustomWidgetFuncs { LowLevel.handleCustom = (Just handleHover) }))+ (Just (LowLevel.defaultCustomWidgetFuncs { LowLevel.handleCustom = Just (handleButtonHover . safeCast) })) buttonSetup b LowLevel.setSelectionColor b yellowColor LowLevel.setAlign b (Alignments [AlignTypeInside, AlignTypeCenter, AlignTypeImageNextToText])@@ -455,8 +463,8 @@ b <- LowLevel.returnButtonCustom rect l (Just ((\b -> do spec <- buttonFillSpec b- drawRegularButton spec b) . safeCast))- (Just (LowLevel.defaultCustomWidgetFuncs { LowLevel.handleCustom = Just handleHover }))+ drawRegularButton spec (safeCast b))))+ (Just (LowLevel.defaultCustomWidgetFuncs { LowLevel.handleCustom = Just (handleButtonHover . safeCast) })) buttonSetup b let (_,_,w',h') = fromRectangle rect LowLevel.setAlign b (Alignments [AlignTypeTextNextToImage])
src/Graphics/UI/FLTK/Theme/Light/ColorChooser.hs view
@@ -738,8 +738,14 @@ (colorChooserSliderBounds componentBounds) Nothing (Just (drawSaturationSlider stateRef))- (Just (LowLevel.defaultCustomWidgetFuncs {LowLevel.handleCustom = Just handleHover}))- sliderSetup g+ (Just (LowLevel.defaultCustomWidgetFuncs {+ LowLevel.handleCustom = Just (\s e -> do+ res <- handleHover s e+ case res of+ Left _ -> LowLevel.handleSliderBase (LowLevel.safeCast s) e+ Right _ -> return (Right ())+ )}))+ sliderSetup (LowLevel.safeCast g) LowLevel.setCallback g (sliderCallback stateRef c) let (paneX, _, paneW, _) = fromRectangle (colorChooserPreviewPaneBounds componentBounds) (Rectangle (Position _ (Y hueBoxY)) (Size _ (Height hueBoxHeight))) = hueBoxBounds (colorChooserHueBoxBounds componentBounds)(hueBoxHandleRadius layout) defaultGaugeHeight
src/Graphics/UI/FLTK/Theme/Light/Common.hs view
@@ -51,6 +51,7 @@ import Graphics.UI.FLTK.LowLevel.Fl_Enumerations import Graphics.UI.FLTK.Theme.Light.Assets import qualified Graphics.UI.FLTK.LowLevel.FL as FL+import Foreign.Ptr -- | For drawing a rectangular widget that is borderless on the top or bottom. Guess -- it could be passed into a function as yet another Bool but we have too many of those@@ -148,7 +149,7 @@ commonSelectionColor = rgbColorWithRgb (50, 100, 201) -- | Check if the given references point to the same 'Widget'.-isWidget :: (Parent a Widget) => Ref a -> IO (Maybe (Ref b)) -> IO Bool+isWidget :: (Parent a WidgetBase) => Ref a -> IO (Maybe (Ref b)) -> IO Bool isWidget this thatM = thatM >>= maybe (return False) (refPtrEquals this) -- | Check if the given 'Position' is inside the 'Rectangle'. Useful for@@ -227,7 +228,7 @@ -- | Draw a bordered rectangle for the given widget according to 'BorderBoxSpec', the 'Bool' -- determines if it should be filled with 'borderBoxFillColor'.-drawBorderBox :: (Parent a Widget) => Ref a -> BorderBoxSpec -> Bool -> IO ()+drawBorderBox :: (Parent a WidgetBase) => Ref a -> BorderBoxSpec -> Bool -> IO () drawBorderBox w spec shouldFill = do oldColor <- flcColor focused <- isWidget w FL.focus@@ -245,14 +246,14 @@ -- | The default FLTK widgets don't react to a mouse pointer hovering over them. -- This handler when applied to a customized widget initiates a 'redraw' when the--- mouse enters and leaves the widget area.+-- mouse enters and leaves the widget area. It also takes this widget's default 'handle'+-- so it can be called for events that don't apply to hovering, eg. Show, Hide etc. handleHover :: (- Parent orig Widget,+ orig ~ (a b),+ Parent orig WidgetBase, Match x ~ FindOp orig orig (Redraw ()),- Op (Redraw ()) x orig (IO ()),- Match y ~ FindOp orig orig (HandleSuper ()),- Op (HandleSuper ()) y orig (Event -> IO (Either UnknownEvent ()))+ Op (Redraw ()) x orig (IO ()) ) => Ref orig -> Event -> IO (Either UnknownEvent ()) handleHover b e = do@@ -263,27 +264,29 @@ Leave -> do () <- redraw b return (Right ())- _ -> handleSuper b e+ _ -> return (Left UnknownEvent) -- | Temporarily swap out the FLTK's box drawing function for a given 'Boxtype' -- with 'BoxDrawF'. The 'IO' '()' action will typically use the custom function -- that was just swapped in some kind custom drawing routine. For example, if a -- custom widget used a 'BorderBox' on the FLTK side but you don't like the -- default 'BorderBox' look, you can override the 'draw' function of the widget--- with this one where the 'IO' '()' action calls 'drawSuper'. For an example+-- with this one where the 'IO' '()' action calls 'draw' on its parent. For an example -- use-case see 'Graphics.UI.FLTK.Theme.Light.Input.inputDraw'. -- -- NOTE: The 'IO' '()' action is /not/ exception safe. withCustomBoxDraw :: Boxtype -> BoxDrawF -> IO () -> IO () withCustomBoxDraw boxtype customBoxDrawF action = do- fptr <- FL.getBoxtypePrim boxtype+ oldFptr <- FL.getBoxtype boxtype dx <- FL.boxDx boxtype dy <- FL.boxDy boxtype dw <- FL.boxDw boxtype dh <- FL.boxDh boxtype FL.setBoxtype boxtype (FL.FromSpec customBoxDrawF 0 0 0 0) action- FL.setBoxtype boxtype (FL.FromFunPtr fptr (fromIntegral dx) (fromIntegral dy) (fromIntegral dw) (fromIntegral dh))+ fptr <- FL.getBoxtype boxtype+ when (fptr /= nullFunPtr) (freeHaskellFunPtr fptr)+ FL.setBoxtype boxtype (FL.FromFunPtr oldFptr (fromIntegral dx) (fromIntegral dy) (fromIntegral dw) (fromIntegral dh)) -- | Make the default 'FillSpec' used by most of the theme color graded with the initial 'Color'. The second 'Color' -- is used to determine the border color.
src/Graphics/UI/FLTK/Theme/Light/Counter.hs view
@@ -14,6 +14,7 @@ import Data.List import Graphics.UI.FLTK.LowLevel.Fl_Enumerations import Graphics.UI.FLTK.LowLevel.Fl_Types+import Graphics.UI.FLTK.LowLevel.Dispatch import Graphics.UI.FLTK.Theme.Light.Button import Graphics.UI.FLTK.Theme.Light.Common import Graphics.UI.FLTK.Theme.Light.Input@@ -121,7 +122,7 @@ Push -> setPressed Drag -> setPressed _ -> return ()- LowLevel.handleSuper c e+ LowLevel.handleCounterBase (safeCast c) e counterNew :: (?assets :: Assets) => Rectangle -> Maybe T.Text -> IO (Ref LowLevel.Counter) counterNew rect l = do
src/Graphics/UI/FLTK/Theme/Light/Input.hs view
@@ -36,7 +36,7 @@ LowLevel.flcVertex (toPrecisePosition (toPosition (x'+w'-1,y'))) LowLevel.flcEndLine -inputDraw :: Ref LowLevel.Input -> IO ()+inputDraw :: Ref LowLevel.InputBase -> IO () inputDraw i = withCustomBoxDraw BorderBox@@ -65,7 +65,7 @@ LowLevel.drawText i rBox) -- | Common setup function for all 'Input' widgets, sets label color, font etc.-inputSetup :: (?assets :: Assets) => Ref LowLevel.Input -> IO ()+inputSetup :: (?assets :: Assets) => Ref LowLevel.InputBase -> IO () inputSetup i = do LowLevel.setColor i lightBackground LowLevel.setBox i BorderBox@@ -78,8 +78,8 @@ inputNew :: (?assets :: Assets) => Rectangle -> Maybe T.Text -> Maybe LowLevel.FlInputType -> IO (Ref LowLevel.Input) inputNew rect l it = do- i <- LowLevel.inputCustom rect l it (Just inputDraw) Nothing- inputSetup i+ i <- LowLevel.inputCustom rect l it (Just (inputDraw . safeCast)) Nothing+ inputSetup (safeCast i) return i fileInputNew :: (?assets :: Assets) => Rectangle -> Maybe T.Text -> IO (Ref LowLevel.FileInput)
src/Graphics/UI/FLTK/Theme/Light/Menu.hs view
@@ -7,6 +7,7 @@ where import Graphics.UI.FLTK.LowLevel.Fl_Enumerations import Graphics.UI.FLTK.LowLevel.Fl_Types+import Graphics.UI.FLTK.LowLevel.Dispatch import Graphics.UI.FLTK.Theme.Light.Common import qualified Data.Text as T import qualified Graphics.UI.FLTK.LowLevel.FLTKHS as LowLevel@@ -39,7 +40,7 @@ LowLevel.flcEndLine LowLevel.flcSetColor color )- (LowLevel.drawSuper m)+ (LowLevel.drawSysMenuBarBase (safeCast m)) m <- LowLevel.sysMenuBarCustom rectangle label@@ -85,4 +86,4 @@ borderBoxFillColor = color, borderBoxBounds = toRectangle (x,y,w-1,h-1) }- withCustomBoxDraw UpBox (\_ _ -> drawBorderBox c spec True) (LowLevel.drawSuper c)+ withCustomBoxDraw UpBox (\_ _ -> drawBorderBox c spec True) (LowLevel.drawChoiceBase (safeCast c))
src/Graphics/UI/FLTK/Theme/Light/Positioner.hs view
@@ -7,6 +7,7 @@ import Graphics.UI.FLTK.Theme.Light.Common import qualified Data.Text as T import qualified Graphics.UI.FLTK.LowLevel.FLTKHS as LowLevel+import Graphics.UI.FLTK.LowLevel.Dispatch import Graphics.UI.FLTK.LowLevel.Fl_Enumerations import Graphics.UI.FLTK.Theme.Light.Assets @@ -21,7 +22,7 @@ (\rect _ -> do LowLevel.flcRectfWithColor rect color LowLevel.flcRectWithColor rect slightlyDarker)- (LowLevel.drawSuper p)+ (LowLevel.drawPositionerBase (safeCast p)) p <- LowLevel.positionerCustom rect l (Just customDraw) Nothing LowLevel.setLabelfont p commonFont LowLevel.setLabelsize p commonFontSize
src/Graphics/UI/FLTK/Theme/Light/Slider.hs view
@@ -34,6 +34,7 @@ import qualified Graphics.UI.FLTK.LowLevel.FL as FL import qualified Graphics.UI.FLTK.LowLevel.FLTKHS as LowLevel import Graphics.UI.FLTK.Theme.Light.Assets+import Data.Either sliderKnobColor :: IO Color sliderKnobColor = rgbColorWithRgb (241,241,241)@@ -47,7 +48,7 @@ sliderIsHorizontal HorNiceSliderType = True sliderSetup ::- (?assets :: Assets) => Ref LowLevel.Slider -> IO ()+ (?assets :: Assets) => Ref LowLevel.SliderBase -> IO () sliderSetup s = do () <- LowLevel.setColor s lightBackground () <- LowLevel.setBox s BorderBox@@ -307,6 +308,12 @@ {-# DEPRECATED horFillSliderNew "Fill sliders are not supported in the Light theme. 'horFillSliderNew' is the same as 'sliderNew'." #-} {-# DEPRECATED horNiceSliderNew "\"Nice\"sliders are not supported in the Light theme. 'horNiceSliderNew' is the same as 'sliderNew'." #-} +handleSliderHover :: Ref LowLevel.SliderBase -> Event -> IO (Either UnknownEvent ())+handleSliderHover s e = do+ res <- handleHover s e+ case res of+ Left _ -> LowLevel.handleSliderBase s e+ Right _ -> return (Right ()) sliderNew :: (?assets :: Assets) => Rectangle -> Maybe T.Text -> IO (Ref LowLevel.Slider) sliderNew rectangle label = do@@ -317,8 +324,8 @@ bounds <- LowLevel.getRectangle s drawSlider s Nothing bounds ))- (Just (LowLevel.defaultCustomWidgetFuncs { LowLevel.handleCustom = (Just handleHover) }))- sliderSetup s+ (Just (LowLevel.defaultCustomWidgetFuncs { LowLevel.handleCustom = (Just (handleSliderHover . safeCast)) }))+ sliderSetup (safeCast s) return s gaugeSliderNew :: (?assets :: Assets) => Rectangle -> Maybe T.Text -> IO (Ref LowLevel.Slider)@@ -330,7 +337,7 @@ bounds <- LowLevel.getRectangle s drawSlider s (Just mkGaugeSliderSpec) bounds ))- (Just (LowLevel.defaultCustomWidgetFuncs {LowLevel.handleCustom = Just handleHover}))+ (Just (LowLevel.defaultCustomWidgetFuncs {LowLevel.handleCustom = Just (handleSliderHover . safeCast)})) sliderSetup (safeCast s) return s @@ -340,7 +347,7 @@ rectangle label (Just drawValueSlider)- (Just (LowLevel.defaultCustomWidgetFuncs { LowLevel.handleCustom = (Just handleHover) }))+ (Just (LowLevel.defaultCustomWidgetFuncs { LowLevel.handleCustom = (Just (handleSliderHover . safeCast)) })) sliderSetup (safeCast s) return s @@ -350,7 +357,7 @@ rectangle label (Just drawValueSlider)- (Just (LowLevel.defaultCustomWidgetFuncs { LowLevel.handleCustom = (Just handleHover) }))+ (Just (LowLevel.defaultCustomWidgetFuncs { LowLevel.handleCustom = (Just (handleSliderHover . safeCast)) })) LowLevel.setType s HorSliderType sliderSetup (safeCast s) return (LowLevel.castTo s)@@ -364,7 +371,7 @@ bounds <- LowLevel.getRectangle s drawSlider s Nothing bounds ))- (Just (LowLevel.defaultCustomWidgetFuncs { LowLevel.handleCustom = (Just handleHover) }))+ (Just (LowLevel.defaultCustomWidgetFuncs { LowLevel.handleCustom = (Just (handleSliderHover . safeCast)) })) LowLevel.setType s HorSliderType sliderSetup (safeCast s) return (LowLevel.castTo s)@@ -378,7 +385,7 @@ bounds <- LowLevel.getRectangle s drawSlider s Nothing bounds ))- (Just (LowLevel.defaultCustomWidgetFuncs { LowLevel.handleCustom = (Just handleHover) }))+ (Just (LowLevel.defaultCustomWidgetFuncs { LowLevel.handleCustom = (Just (handleSliderHover . safeCast)) })) LowLevel.setType s VertFillSliderType sliderSetup (safeCast s) return (LowLevel.castTo s)@@ -392,7 +399,7 @@ bounds <- LowLevel.getRectangle s drawSlider s Nothing bounds ))- (Just (LowLevel.defaultCustomWidgetFuncs { LowLevel.handleCustom = (Just handleHover) }))+ (Just (LowLevel.defaultCustomWidgetFuncs { LowLevel.handleCustom = (Just (handleSliderHover . safeCast)) })) sliderSetup (safeCast s) LowLevel.setType s HorFillSliderType return (LowLevel.castTo s)@@ -406,7 +413,7 @@ bounds <- LowLevel.getRectangle s drawSlider s Nothing bounds ))- (Just (LowLevel.defaultCustomWidgetFuncs { LowLevel.handleCustom = (Just handleHover) }))+ (Just (LowLevel.defaultCustomWidgetFuncs { LowLevel.handleCustom = (Just (handleSliderHover . safeCast)) })) sliderSetup (safeCast s) LowLevel.setType s HorNiceSliderType return (LowLevel.castTo s)
src/Graphics/UI/FLTK/Theme/Light/Spinner.hs view
@@ -52,7 +52,7 @@ case e of Keydown -> upOrDown Shortcut -> upOrDown- _ -> LowLevel.handleSuper (safeCast s :: Ref LowLevel.Group) e+ _ -> LowLevel.handleSpinnerBase (safeCast s) e updateInput :: Maybe T.Text -> Double -> Ref LowLevel.Input -> IO () updateInput format v i =@@ -64,7 +64,7 @@ resizeSpinner :: Ref LowLevel.Input -> Ref LowLevel.Button -> Ref LowLevel.Button -> Ref LowLevel.Spinner -> Rectangle -> IO () resizeSpinner i up down s r = do- LowLevel.resizeSuper (safeCast s :: Ref LowLevel.Group) r+ LowLevel.resizeSpinnerBase (safeCast s) r let (iRect,upRect,downRect) = spinnerComponentBounds r LowLevel.resize i iRect LowLevel.resize up upRect@@ -168,7 +168,7 @@ spec <- buttonFillSpec b r <- LowLevel.getRectangle b s <- LowLevel.getDataSize upSmallImage- drawRegularButton (spec { fillCornerRadius = 0 }) b+ drawRegularButton (spec { fillCornerRadius = 0 }) (safeCast b) LowLevel.draw upSmallImage (centerInRectangle r s))) Nothing buttonSetup upButton@@ -180,7 +180,7 @@ spec <- buttonFillSpec b r <- LowLevel.getRectangle b s <- LowLevel.getDataSize upSmallImage- drawRegularButton (spec { fillCornerRadius = 0 }) b+ drawRegularButton (spec { fillCornerRadius = 0 }) (safeCast b) LowLevel.draw downSmallImage (centerInRectangle r s))) Nothing buttonSetup downButton
src/Graphics/UI/FLTK/Theme/Light/Tabs.hs view
@@ -19,6 +19,7 @@ import Graphics.UI.FLTK.LowLevel.Dispatch (safeCast) import Graphics.UI.FLTK.LowLevel.Fl_Enumerations import Graphics.UI.FLTK.LowLevel.Fl_Types+import Graphics.UI.FLTK.LowLevel.Dispatch import Graphics.UI.FLTK.Theme.Light.Common import qualified Data.Text as T import qualified Graphics.UI.FLTK.LowLevel.FL as FL@@ -170,7 +171,7 @@ handleRelease = do tabBarRect <- tabBarRectangle spec t if (not (insideRectangle pos tabBarRect))- then LowLevel.handleSuper t e+ then LowLevel.handleTabsBase (safeCast t) e else do lastSelected <- LowLevel.getPush t _ <- LowLevel.setPush t (Nothing :: (Maybe (Ref LowLevel.Widget)))@@ -195,7 +196,7 @@ else return (Right ()) handlePush = let adjustWhenNot yOutsideRange =- if yOutsideRange then LowLevel.handleSuper (safeCast t :: Ref LowLevel.Group) e+ if yOutsideRange then LowLevel.handleTabsBase (safeCast t) e else case nextIndex of Just (AtIndex i) ->@@ -231,7 +232,7 @@ SpecialKeyType Kb_Left -> case selectedMaybe of Just (AtIndex i) ->- if (i == 0) then LowLevel.handleSuper t e+ if (i == 0) then LowLevel.handleTabsBase (safeCast t) e else let (X x, _) = offsetWidths !! (i-1) currOffset = x - tabsX@@ -239,21 +240,21 @@ if (currOffset >= 0) then return () else adjustOffset (currOffset - (if (i > 1) then partiallyShow (i-2) else 0))- LowLevel.handleSuper t e- _ -> LowLevel.handleSuper t e+ LowLevel.handleTabsBase (safeCast t) e+ _ -> LowLevel.handleTabsBase (safeCast t) e SpecialKeyType Kb_Right -> case selectedMaybe of Just (AtIndex i) ->- if (i == ((length widths) - 1)) then LowLevel.handleSuper t e+ if (i == ((length widths) - 1)) then LowLevel.handleTabsBase (safeCast t) e else let (X x,Width w) = offsetWidths !! (i+1) currOffset = (x+w) - (tabsX+tabsWidth) in do when (currOffset >= 0) (adjustOffset (currOffset + (if (i < (length widths - 2)) then partiallyShow (i+2) else 0)))- LowLevel.handleSuper t e- _ -> LowLevel.handleSuper t e- _ -> LowLevel.handleSuper t e- _ -> LowLevel.handleSuper t e+ LowLevel.handleTabsBase (safeCast t) e+ _ -> LowLevel.handleTabsBase (safeCast t) e+ _ -> LowLevel.handleTabsBase (safeCast t) e+ _ -> LowLevel.handleTabsBase (safeCast t) e -- | Calculate the width and x coordinate of each tab lightTabPositionsCustom :: TabSpec -> Ref LowLevel.Tabs -> IO (Maybe AtIndex, Int, [(X,Width)])@@ -279,7 +280,7 @@ let xOffsets = zip (map X (map ((+) x) (scanl (+) 0 widths))) (map Width widths) return (selected, (0 :: Int), xOffsets) where- selectedTab :: [(AtIndex, Ref LowLevel.Widget)] -> IO (Maybe AtIndex)+ selectedTab :: [(AtIndex, Ref LowLevel.WidgetBase)] -> IO (Maybe AtIndex) selectedTab [] = return Nothing selectedTab ((i,w):ws) = do v <- LowLevel.getVisible w@@ -333,7 +334,7 @@ else toRectangle (tabsX,tabsY,tabsW,tabHeight)) -- | Determine which tab was just selected-lightTabWhichCustom :: TabSpec -> Ref LowLevel.Tabs -> Position -> IO (Maybe (AtIndex, Ref LowLevel.Widget))+lightTabWhichCustom :: TabSpec -> Ref LowLevel.Tabs -> Position -> IO (Maybe (AtIndex, Ref LowLevel.WidgetBase)) lightTabWhichCustom spec t pos = do tabBarRect <- tabBarRectangle spec t if (not (insideRectangle pos tabBarRect))
src/Graphics/UI/FLTK/Theme/Light/Tree.hs view
@@ -6,6 +6,7 @@ where import Graphics.UI.FLTK.LowLevel.Fl_Enumerations import Graphics.UI.FLTK.LowLevel.Fl_Types+import Graphics.UI.FLTK.LowLevel.Dispatch import Graphics.UI.FLTK.Theme.Light.Common import qualified Data.Text as T import qualified Graphics.UI.FLTK.LowLevel.FLTKHS as LowLevel@@ -22,7 +23,7 @@ (\rect _ -> do LowLevel.flcRectfWithColor rect color LowLevel.flcRectWithColor rect slightlyDarker)- (LowLevel.drawSuper t)+ (LowLevel.drawTreeBase (safeCast t)) t <- LowLevel.treeCustom rectangle l' (Just customDraw) Nothing LowLevel.setBox t BorderBox LowLevel.setColor t lightBackground
src/Graphics/UI/FLTK/Theme/Light/Valuator.hs view
@@ -8,6 +8,7 @@ where import Graphics.UI.FLTK.LowLevel.Fl_Enumerations import Graphics.UI.FLTK.LowLevel.Fl_Types+import Graphics.UI.FLTK.LowLevel.Dispatch import Graphics.UI.FLTK.Theme.Light.Common import Graphics.UI.FLTK.Theme.Light.Input import qualified Data.Text as T@@ -36,7 +37,7 @@ LowLevel.flcRectfWithColor rect color focused <- isWidget vo FL.focus inputBox focused rect color)- (LowLevel.drawSuper vo)+ (LowLevel.drawValueOutputBase (safeCast vo)) vo <- LowLevel.valueOutputCustom rect l (Just customDraw) Nothing LowLevel.setColor vo lightBackground LowLevel.setBox vo BorderBox@@ -58,7 +59,7 @@ LowLevel.flcRectfWithColor rect color focused <- isWidget vi FL.focus inputBox focused rect color)- (LowLevel.drawSuper vi)+ (LowLevel.drawValueInputBase (safeCast vi)) vi <- LowLevel.valueInputCustom rect l (Just customDraw) Nothing LowLevel.setColor vi lightBackground LowLevel.setBox vi BorderBox