diff --git a/fltkhs-themes.cabal b/fltkhs-themes.cabal --- a/fltkhs-themes.cabal +++ b/fltkhs-themes.cabal @@ -1,11 +1,13 @@ --- This file has been generated from package.yaml by hpack version 0.28.2. +cabal-version: 1.24 + +-- This file has been generated from package.yaml by hpack version 0.31.1. -- -- see: https://github.com/sol/hpack -- --- hash: 5ed32d2a937a5f725b45ff98922f1d8ea9e01f97e9c23c5749edf5410670dd49 +-- hash: 9d37c0743e1b91bd5c46b144c5b33aa83c94e0ca50eee662d4a8b2e961702eeb name: fltkhs-themes -version: 0.1.0.6 +version: 0.1.0.7 synopsis: A set of themed widgets that provides drop in replacements to the ones in FLTKHS. description: Please see the README on Github at category: UI,Graphics,GUI,User Interfaces @@ -17,7 +19,6 @@ license: BSD3 license-file: LICENSE build-type: Custom -cabal-version: >= 1.24 extra-source-files: README.org extra-doc-files: diff --git a/src/Graphics/UI/FLTK/Theme/Light/Assets.hs b/src/Graphics/UI/FLTK/Theme/Light/Assets.hs --- a/src/Graphics/UI/FLTK/Theme/Light/Assets.hs +++ b/src/Graphics/UI/FLTK/Theme/Light/Assets.hs @@ -49,6 +49,7 @@ import Data.Maybe import Control.Monad import Paths_fltkhs_themes +import Control.Applicative -- | An opaque type that contains all of the resources needed by this theme. -- Getting to the resources requires threading something of the type as an implicit @@ -128,7 +129,7 @@ [ "DejaVu Sans" , "Yanone Kaffeesatz Regular" - , "Josefin Slab" + , "Josefin Slab SemiBold" ] imagePaths :: [FilePath] @@ -161,7 +162,7 @@ images <- mapM (\p -> do bytes <- B.readFile p `catch` - (\(e :: SomeException) -> ioError + (\(_ :: SomeException) -> ioError (userError ("loadAssets (fatal error): image does not exist at path: " ++ p))) iE <- pngImageNewWithData (T.pack "") bytes case iE of @@ -177,7 +178,13 @@ return (face,f) ) fonts - let fontNumbers = catMaybes (Data.List.map (\fName -> Prelude.lookup fName withFaces) fontNames) + let fontNumbers = catMaybes (Data.List.map (\fName -> + -- OSX Mojave sees this font as "Josefin Slab SemiBold" while Linux and Windows + -- see it as "Josefin Slab" + if (fName == "Josefin Slab SemiBold") + then (Prelude.lookup fName withFaces) <|> (Prelude.lookup "Josefin Slab" withFaces) + else Prelude.lookup fName withFaces) + fontNames) _ <- FL.setScheme "gtk+" let addImages as = as (images !! 0) (images !! 1) diff --git a/src/Graphics/UI/FLTK/Theme/Light/Button.hs b/src/Graphics/UI/FLTK/Theme/Light/Button.hs --- a/src/Graphics/UI/FLTK/Theme/Light/Button.hs +++ b/src/Graphics/UI/FLTK/Theme/Light/Button.hs @@ -34,7 +34,6 @@ import qualified Data.Text.Encoding as TE import qualified Graphics.UI.FLTK.LowLevel.FL as FL import qualified Graphics.UI.FLTK.LowLevel.FLTKHS as LowLevel -import qualified Graphics.UI.FLTK.LowLevel.Dispatch import Graphics.UI.FLTK.Theme.Light.Assets -- | Check of the given button is 'HiddenButtonType' @@ -140,7 +139,6 @@ arrowY = y + (h `intDiv` 2) - (arrowSize `intDiv` 2) arrowBoundingBox = toRectangle (arrowX, arrowY, arrowSize, arrowSize) in do - oldColor <- LowLevel.flcColor LowLevel.flcSetColor arrowColor LowLevel.flcBeginPolygon LowLevel.flcVertex (PrecisePosition (PreciseX (fromIntegral arrowX)) (PreciseY (fromIntegral arrowY))) @@ -158,7 +156,6 @@ let noBox = case b of { NoBox -> True; _ -> False } if (t /= 0 || noBox) then return () else do - fillSpec <- buttonFillSpec m itemIndex <- LowLevel.getValue m fontSize <- LowLevel.getLabelsize m drawIndicatorButton (\spec _ color fs -> drawDownArrow (fillBounds spec) color fs) (maybe False (const True) itemIndex) False False fontSize m @@ -166,7 +163,7 @@ -- | Draw the light part of a LightButton. The 'Bool' indicates whether the light is on. drawLight :: FillSpec -> Bool -> Color -> FontSize -> IO Rectangle drawLight spec lightOn lightColor (FontSize lightDiameter) = - let (x,y,w,h) = fromRectangle (fillBounds spec) + let (x,y,_,h) = fromRectangle (fillBounds spec) lightX = x + 3 lightY = y + (h `intDiv` 2) lightRadius = (fromIntegral lightDiameter / 2.0) @@ -186,7 +183,7 @@ -- | Draw the radio part of a RoundButton. The 'Bool' indicates whether it is enabled. drawRound :: FillSpec -> Bool -> Color -> FontSize -> IO Rectangle drawRound spec radioOn radioColor (FontSize fs) = - let (x,y,w,h) = fromRectangle (fillBounds spec) + let (x,y,_,h) = fromRectangle (fillBounds spec) radioBoxX = x + 3 radioBoxY = fromIntegral y + (fromIntegral h / 2.0) radioBoxWidth :: Int @@ -199,10 +196,8 @@ "\n" ++ "" ++ "\n" + radioRadius :: Double radioRadius = (fromIntegral radioBoxWidth) / 4.5 - radioDiameter = radioRadius * 2 - radioX = fromIntegral radioBoxX + radioBoxHalfway - radioRadius - radioY = radioBoxY - radioRadius in do (borderColorR, borderColorG, borderColorB) <- FL.getColorRgb (fillBorderColor spec) (radioColorR, radioColorG, radioColorB) <- FL.getColorRgb (if radioOn then radioColor else (fillTopColor spec)) @@ -226,7 +221,7 @@ -- | Draw the check part of a CheckButton. The 'Bool' indicated whether to draw the check or not. drawCheck :: FillSpec -> Bool -> Color -> FontSize -> IO Rectangle drawCheck spec checked checkColor (FontSize fontSize) = - let (x,y,w,h) = fromRectangle (fillBounds spec) + let (x,y,_,h) = fromRectangle (fillBounds spec) checkBoxWidth :: Int = fromIntegral fontSize checkBoxHeight = checkBoxWidth checkBoxX = x + 3 @@ -397,7 +392,6 @@ (do (x,y,w,h) <- fmap fromRectangle (LowLevel.getRectangle b) bx <- FL.boxDx BorderBox - c <- LowLevel.getColor b (FontSize labelWCInt) <- LowLevel.getLabelsize b v <- LowLevel.getValue b let labelW :: Int diff --git a/src/Graphics/UI/FLTK/Theme/Light/ColorChooser.hs b/src/Graphics/UI/FLTK/Theme/Light/ColorChooser.hs --- a/src/Graphics/UI/FLTK/Theme/Light/ColorChooser.hs +++ b/src/Graphics/UI/FLTK/Theme/Light/ColorChooser.hs @@ -38,10 +38,8 @@ import Foreign.C.Types import Graphics.UI.FLTK.LowLevel.Fl_Enumerations as 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.Dial -import Graphics.UI.FLTK.Theme.Light.Group import Graphics.UI.FLTK.Theme.Light.Menu import Graphics.UI.FLTK.Theme.Light.Slider import Graphics.UI.FLTK.Theme.Light.Window @@ -164,7 +162,6 @@ LowLevel.draw i (Position (X (x'+1)) (Y (y'+1))) LowLevel.destroy i) iM - damages <- LowLevel.getDamage b let svg = Printf.printf hueBoxHandleSvg (handleRadius*2) (handleRadius*2) (-handleRadius) (-handleRadius) (handleRadius*2) (handleRadius*2) @@ -217,10 +214,7 @@ innerRectHeight = h'-(paddingHeight*2) betweenPadding = (betweenPaddingPercent layout) `percentOf` innerRectWidth outerHueBoxWidth = (hueBoxWidthPercentage layout) `percentOf` innerRectWidth - hueBoxWidth = outerHueBoxWidth - (truncate (hueBoxHandleRadius layout*2.0)) - hueBoxHeight = innerRectHeight-gaugeHeight sliderWidth = (sliderWidthPercentage layout) `percentOf` innerRectWidth - innerRect = (x'+paddingWidth,y'+paddingHeight,innerRectWidth,innerRectHeight) previewPaneWidth = (previewPanePercentage layout) `percentOf` innerRectWidth in ColorChooserComponentBounds @@ -295,7 +289,7 @@ -- | Generate the background of the saturation slider generateVImage :: RGB -> Size -> IO (Ref LowLevel.SVGImage) -generateVImage (r',g',b') size@(Size (Width w') (Height h')) = +generateVImage (r',g',b') (Size (Width w') (Height h')) = let svgString :: String svgString = "\n" ++ @@ -329,7 +323,7 @@ in do vf <- FL.visibleFocus when vf ((FL.setFocus b) >> LowLevel.redraw b) - eventPos@(Position (X ex)(Y ey)) <- FL.eventPosition + (Position (X ex)(Y ey)) <- FL.eventPosition let xDiff = ex-x' xIncrement = if (xDiff <= 0) then 0.0 @@ -434,7 +428,6 @@ LowLevel.setDamage hueBox [DamageScroll] LowLevel.setDamage slider [DamageExpose] LowLevel.setDamage previewGroup [DamageExpose] - ds <- LowLevel.getDamage slider modifyIORef stateRef (\state -> state { colorChooserHue = Between0And6 h })) when (s /= currS) (do @@ -444,7 +437,7 @@ modifyIORef stateRef (\state -> state { colorChooserSaturation = Between0And1 s })) when (v /= currV) (do - LowLevel.setValue slider (1-v) + _ <- LowLevel.setValue slider (1-v) LowLevel.setDamage previewGroup [DamageExpose] modifyIORef stateRef (\state -> state { colorChooserValue = Between0And1 v })) when (changed == 1) @@ -518,9 +511,9 @@ gV <- LowLevel.getValue gValue bV <- LowLevel.getValue bValue m <- LowLevel.getMode c - case m of - HsvMode -> LowLevel.setHsv c (Between0And6 rV, Between0And1 gV, Between0And1 bV) - _ -> LowLevel.setRgb c (Between0And1 rV, Between0And1 gV, Between0And1 bV) + _ <- case m of + HsvMode -> LowLevel.setHsv c (Between0And6 rV, Between0And1 gV, Between0And1 bV) + _ -> LowLevel.setRgb c (Between0And1 rV, Between0And1 gV, Between0And1 bV) LowLevel.doCallback c -- | React to changes in the saturation slider @@ -528,7 +521,7 @@ sliderCallback stateRef c slider = do state <- readIORef stateRef v <- LowLevel.getValue slider - LowLevel.setHsv c (colorChooserHue state, colorChooserSaturation state, Between0And1 (1.0-v)) + _ <- LowLevel.setHsv c (colorChooserHue state, colorChooserSaturation state, Between0And1 (1.0-v)) LowLevel.doCallback c -- | Set the dials according the selected color @@ -547,9 +540,9 @@ LowLevel.setStep i (1%1000) LowLevel.precision i 3) [rInput,gInput,bInput] - LowLevel.setValue rInput r - LowLevel.setValue gInput g - LowLevel.setValue bInput b + _ <- LowLevel.setValue rInput r + _ <- LowLevel.setValue gInput g + _ <- LowLevel.setValue bInput b LowLevel.setSelectionColor rInput redColor LowLevel.setSelectionColor gInput greenColor LowLevel.setSelectionColor bInput blueColor @@ -568,9 +561,9 @@ LowLevel.range i 0 1 LowLevel.setStep i (1%1000)) [gInput,bInput] - LowLevel.setValue rInput h - LowLevel.setValue gInput s - LowLevel.setValue bInput v + _ <- LowLevel.setValue rInput h + _ <- LowLevel.setValue gInput s + _ <- LowLevel.setValue bInput v color <- commonFillColor LowLevel.setSelectionColor rInput color LowLevel.setSelectionColor gInput color @@ -589,9 +582,9 @@ LowLevel.setStep i 1 LowLevel.precision i 3) [rInput,gInput,bInput] - LowLevel.setValue rInput r - LowLevel.setValue gInput g - LowLevel.setValue bInput b + _ <- LowLevel.setValue rInput r + _ <- LowLevel.setValue gInput g + _ <- LowLevel.setValue bInput b LowLevel.setSelectionColor rInput redColor LowLevel.setSelectionColor gInput greenColor LowLevel.setSelectionColor bInput blueColor @@ -609,9 +602,9 @@ LowLevel.setStep i 1 LowLevel.precision i 3) [rInput,gInput,bInput] - LowLevel.setValue rInput r - LowLevel.setValue gInput g - LowLevel.setValue bInput b + _ <- LowLevel.setValue rInput r + _ <- LowLevel.setValue gInput g + _ <- LowLevel.setValue bInput b LowLevel.setSelectionColor rInput redColor LowLevel.setSelectionColor gInput greenColor LowLevel.setSelectionColor bInput blueColor @@ -654,7 +647,7 @@ let modeMenuHeight = 20 colorDialHeight = 40 modeMenuPadding = 3 - (x',y',w',h') = fromRectangle rect + (x',y',w',_) = fromRectangle rect dialSize = Size (Width colorDialHeight) (Height colorDialHeight) in do modeMenu <- choiceNew (toRectangle (x',y',w',modeMenuHeight)) Nothing @@ -681,14 +674,14 @@ previewGroup <- groupNew (toRectangle (x',colorDialGroupY+colorDialGroupH,w',colorDialGroupY-y')) Nothing let previewBoxHeight = 20 -- (h'-colorDialGroupH-modeMenuHeight-modeMenuPadding) `intDiv` 2 LowLevel.begin previewGroup - LowLevel.boxCustom (toRectangle (x',colorDialGroupY+colorDialGroupH+modeMenuPadding,w',previewBoxHeight-modeMenuPadding)) Nothing - (Just (drawPreviewColor c)) - Nothing + _ <- LowLevel.boxCustom (toRectangle (x',colorDialGroupY+colorDialGroupH+modeMenuPadding,w',previewBoxHeight-modeMenuPadding)) Nothing + (Just (drawPreviewColor c)) + Nothing case initialColor of Just initialColor' -> do - LowLevel.boxCustom (toRectangle (x',colorDialGroupY+colorDialGroupH+modeMenuPadding+previewBoxHeight,w',previewBoxHeight-modeMenuPadding)) Nothing - (Just (drawCurrentColor initialColor')) - Nothing + _ <- LowLevel.boxCustom (toRectangle (x',colorDialGroupY+colorDialGroupH+modeMenuPadding+previewBoxHeight,w',previewBoxHeight-modeMenuPadding)) Nothing + (Just (drawCurrentColor initialColor')) + Nothing return () Nothing -> return () LowLevel.end previewGroup @@ -748,7 +741,7 @@ (Just (LowLevel.defaultCustomWidgetFuncs {LowLevel.handleCustom = Just handleHover})) sliderSetup g LowLevel.setCallback g (sliderCallback stateRef c) - let (paneX, paneY, paneW, paneH) = fromRectangle (colorChooserPreviewPaneBounds componentBounds) + let (paneX, _, paneW, _) = fromRectangle (colorChooserPreviewPaneBounds componentBounds) (Rectangle (Position _ (Y hueBoxY)) (Size _ (Height hueBoxHeight))) = hueBoxBounds (colorChooserHueBoxBounds componentBounds)(hueBoxHandleRadius layout) defaultGaugeHeight rgbE <- LowLevel.getRgb c let previewPaneDialBounds = toRectangle (paneX,hueBoxY,paneW,hueBoxHeight) @@ -759,10 +752,10 @@ LowLevel.setResizable previewPaneDialGroup (Nothing :: (Maybe (Ref LowLevel.Widget))) either (\_ -> return ()) - (\rgb@(Between0And1 r,Between0And1 g,Between0And1 b) -> do - LowLevel.setValue rValue r - LowLevel.setValue gValue g - LowLevel.setValue bValue b + (\(Between0And1 r,Between0And1 g,Between0And1 b) -> do + _ <- LowLevel.setValue rValue r + _ <- LowLevel.setValue gValue g + _ <- LowLevel.setValue bValue b setValuators rValue gValue bValue c return ()) rgbE @@ -781,10 +774,10 @@ colorChooserPadding = 5 windowBounds = maybe ((Rectangle (Position (X 215) (Y 200)) (Size (Width 400) (Height (200 + buttonBarHeight))))) id rectM colorChooserBounds = - let (x',y',w',h') = fromRectangle windowBounds + let (_,_,w',h') = fromRectangle windowBounds in toRectangle(colorChooserPadding,0,w'-(colorChooserPadding*2),h'-buttonBarHeight) buttonBarBounds = - let (x',y',w',h') = fromRectangle windowBounds + let (_,_,w',h') = fromRectangle windowBounds in toRectangle (colorChooserPadding,h'-buttonBarHeight,w'-(colorChooserPadding*2),buttonBarHeight) buttonWidth = 65 buttonHeight = 30 diff --git a/src/Graphics/UI/FLTK/Theme/Light/Common.hs b/src/Graphics/UI/FLTK/Theme/Light/Common.hs --- a/src/Graphics/UI/FLTK/Theme/Light/Common.hs +++ b/src/Graphics/UI/FLTK/Theme/Light/Common.hs @@ -412,7 +412,7 @@ -- not checked. positionInside :: Rectangle -> Size -> X -> Y -> Rectangle positionInside r (Size (Width sW) (Height sH)) (X xOff) (Y yOff) = - let (rX,rY,rW,rH) = fromRectangle r + let (rX,rY,_,_) = fromRectangle r in toRectangle (rX+xOff,rY+yOff,sW,sH) -- | Transform the height. diff --git a/src/Graphics/UI/FLTK/Theme/Light/Counter.hs b/src/Graphics/UI/FLTK/Theme/Light/Counter.hs --- a/src/Graphics/UI/FLTK/Theme/Light/Counter.hs +++ b/src/Graphics/UI/FLTK/Theme/Light/Counter.hs @@ -70,7 +70,6 @@ let arrowBox :: Color -> Rectangle -> Bool -> Ref LowLevel.PNGImage -> IO () arrowBox color rect pressed logo = do selectionColor <- LowLevel.getSelectionColor c - fontSize <- LowLevel.getLabelsize c spec <- makeFillSpec rect color selectionColor fillRectangle (spec { fillCornerRadius = 0 }) pressed LowLevel.flcBeginLine diff --git a/src/Graphics/UI/FLTK/Theme/Light/Dial.hs b/src/Graphics/UI/FLTK/Theme/Light/Dial.hs --- a/src/Graphics/UI/FLTK/Theme/Light/Dial.hs +++ b/src/Graphics/UI/FLTK/Theme/Light/Dial.hs @@ -21,6 +21,7 @@ import qualified Graphics.UI.FLTK.LowLevel.FLTKHS as LowLevel import Graphics.UI.FLTK.Theme.Light.Assets + dialOutline w h rW rH a1X a1Y rWWithStroke rHWithStroke bigCircle a2X a2Y sw colorString = "" ++ "" ++ "" +arrow :: [String] arrow = [ "" @@ -86,12 +88,19 @@ center :: Int -> Int -> (Double,Double) center w h = (fromIntegral w / 2, fromIntegral h / 2) +strokeWidth :: PreciseSize -> Double strokeWidth = percentOfSmallerEllipseRadius 10 +meterCenterRadius :: PreciseSize -> Double meterCenterRadius = percentOfSmallerEllipseRadius 8 +meterWidth :: PreciseSize -> Double meterWidth = percentOfSmallerEllipseRadius 5 +knobPadding :: PreciseSize -> Double knobPadding = percentOfSmallerEllipseRadius 3 +arrowBase :: PreciseSize -> Double arrowBase = percentOfSmallerEllipseRadius 25 +arrowHeight :: PreciseSize -> Double arrowHeight = percentOfSmallerEllipseRadius 20 +arrowPadding :: PreciseSize -> Double arrowPadding = percentOfSmallerEllipseRadius 15 makeMeter :: PreciseAngle -> Size -> String @@ -133,6 +142,7 @@ (circleR-sw-arrH-knobP-arrP) (arrH/2) (circleR-sw-arrH-knobP-arrP) (-(arrB/2)) +wrapSvgs :: [String] -> String wrapSvgs svgs = concat (intersperse "\n" ([""] ++ svgs ++ [""])) diff --git a/src/Graphics/UI/FLTK/Theme/Light/Misc.hs b/src/Graphics/UI/FLTK/Theme/Light/Misc.hs --- a/src/Graphics/UI/FLTK/Theme/Light/Misc.hs +++ b/src/Graphics/UI/FLTK/Theme/Light/Misc.hs @@ -12,8 +12,8 @@ import Graphics.UI.FLTK.Theme.Light.Common import Graphics.UI.FLTK.Theme.Light.Assets -drawBackground :: (?assets :: Assets) => Color -> FillSpec -> Alignments -> LowLevel.Ref LowLevel.Box -> IO () -drawBackground c spec alignments b = do +drawBackground :: (?assets :: Assets) => FillSpec -> Alignments -> LowLevel.Ref LowLevel.Box -> IO () +drawBackground spec alignments b = do r <- LowLevel.getRectangle b fillRectangle (spec { fillBounds = r }) False LowLevel.drawLabel b (Just (r,alignments)) @@ -41,7 +41,7 @@ , fillBorderHovered = c } in do - b <- LowLevel.boxCustom r (Just l) (Just (drawBackground c fillSpec alignments)) Nothing + b <- LowLevel.boxCustom r (Just l) (Just (drawBackground fillSpec alignments)) Nothing LowLevel.setLabel b l return b diff --git a/src/Graphics/UI/FLTK/Theme/Light/Slider.hs b/src/Graphics/UI/FLTK/Theme/Light/Slider.hs --- a/src/Graphics/UI/FLTK/Theme/Light/Slider.hs +++ b/src/Graphics/UI/FLTK/Theme/Light/Slider.hs @@ -33,8 +33,6 @@ import qualified Data.Text.Encoding as TE import qualified Graphics.UI.FLTK.LowLevel.FL as FL import qualified Graphics.UI.FLTK.LowLevel.FLTKHS as LowLevel -import qualified Graphics.UI.FLTK.LowLevel.Hierarchy as Hierarchy -import qualified Graphics.UI.FLTK.LowLevel.Dispatch import Graphics.UI.FLTK.Theme.Light.Assets sliderKnobColor :: IO Color @@ -71,6 +69,7 @@ defaultGaugeHeight :: Int defaultGaugeHeight = 10 +mkGaugeSliderSpec :: GaugeSliderSpec mkGaugeSliderSpec = GaugeSliderSpec { @@ -164,18 +163,15 @@ Nothing -> toRectangle (x,y,w-1,h-1) Just spec -> gaugeBoxBounds (sliderIsHorizontal t) spec rect } - (xDiff,yDiff,wDiff,hDiff) = FL.boxDifferences rect (borderBoxBounds spec) drawBorderBox s spec (maybe True (\_ -> False) gaugeSpec) LowLevel.drawLabel s Nothing min' <- LowLevel.getMinimum s max' <- LowLevel.getMaximum s value' <- fmap (sliderValue min' max') (LowLevel.getValue s) - oldColor <- LowLevel.flcColor case gaugeSpec of Nothing -> drawPill rect value' (sliderIsHorizontal t) Just gaugeSpec -> - let (xDiff,yDiff,wDiff,hDiff) = FL.boxDifferences rect (borderBoxBounds spec) - (xPad,yPad) = (xDiff `intDiv` 2, yDiff `intDiv` 2) + let (xDiff,yDiff,_,_) = FL.boxDifferences rect (borderBoxBounds spec) in do LowLevel.flcRectfWithColor (toRectangle (x,y,w,yDiff)) color LowLevel.flcRectfWithColor (toRectangle (x,y+yDiff,xDiff,h-(yDiff*2))) color @@ -185,9 +181,8 @@ drawGauge (borderBoxBounds spec) triangleColor rect value' (sliderIsHorizontal t) gaugeSpec where gaugeSvg (borderR,borderG,borderB) bounds innerBounds v horizontal spec = - let (x',y',w',h') = fromRectangle bounds + let (_,_,w',h') = fromRectangle bounds (_,_,innerW,innerH) = fromRectangle innerBounds - (doubleX,doubleY,doubleW,doubleH) = (fromIntegral x',fromIntegral y',fromIntegral w',fromIntegral h') svg = "\n" ++ "\n" @@ -253,8 +248,6 @@ pillCornerRadius = 2 pillLength :: Double pillLength = 20.0 - pillCenter :: Double - pillCenter = pillLength / 2.0 pillPadding :: Int pillPadding = 3 pillEndPadding :: Int diff --git a/src/Graphics/UI/FLTK/Theme/Light/Spinner.hs b/src/Graphics/UI/FLTK/Theme/Light/Spinner.hs --- a/src/Graphics/UI/FLTK/Theme/Light/Spinner.hs +++ b/src/Graphics/UI/FLTK/Theme/Light/Spinner.hs @@ -157,7 +157,7 @@ let (inputRect,upRect,downRect) = spinnerComponentBounds rect LowLevel.begin s i <- inputNew inputRect Nothing Nothing - LowLevel.setValue i "1" + _ <- LowLevel.setValue i "1" LowLevel.setInputType i LowLevel.FlIntInput LowLevel.setWhen i [WhenEnterKey, WhenRelease] LowLevel.setCallback i (spinnerInputCallback s) diff --git a/src/Graphics/UI/FLTK/Theme/Light/Tabs.hs b/src/Graphics/UI/FLTK/Theme/Light/Tabs.hs --- a/src/Graphics/UI/FLTK/Theme/Light/Tabs.hs +++ b/src/Graphics/UI/FLTK/Theme/Light/Tabs.hs @@ -68,7 +68,6 @@ LowLevel.flcEndLine LowLevel.flcBeginLine LowLevel.flcVertex (toPrecisePosition (Position (X (tabSelectedX + tabSelectedWidth)) yOffset)) - let tabsEnd = if (tabsX + tabsWidth < rightMostX) then tabsX + tabsWidth else rightMostX LowLevel.flcVertex (toPrecisePosition (Position (X (tabsX+tabsWidth)) yOffset)) LowLevel.flcEndLine LowLevel.flcPopClip @@ -139,8 +138,8 @@ LowLevel.flcSetDrawShortcut oldShortcut -- | Damage the tabs widget appropriately for redraw -lightTabRedrawTabs :: TabSpec -> Ref LowLevel.Tabs -> IO () -lightTabRedrawTabs spec t = do +lightTabRedrawTabs :: Ref LowLevel.Tabs -> IO () +lightTabRedrawTabs t = do bounds <- LowLevel.getRectangle t let (tabsX,tabsY,tabsWidth,tabsHeight) = fromRectangle bounds (Height tabHeight) <- LowLevel.tabHeight t @@ -152,11 +151,10 @@ -- | Handles all events to the tab lightTabHandleCustom :: TabSpec -> Ref LowLevel.Tabs -> Event -> IO (Either UnknownEvent ()) lightTabHandleCustom spec t e = do - tl <- LowLevel.getLabel t bounds <- LowLevel.getRectangle t let (tabsX,tabsY,tabsWidth,tabsHeight) = fromRectangle bounds offset <- readIORef (tabViewOffset spec) - pos@(Position (X x') (Y y')) <- FL.eventPosition + pos@(Position _ (Y y')) <- FL.eventPosition nextIndexAndWidget <- lightTabWhichCustom spec t pos (_,_,widths) <- lightTabPositionsCustom spec t let nextWidget = fmap (\(_,w) -> w) nextIndexAndWidget @@ -175,8 +173,7 @@ then LowLevel.handleSuper t e else do lastSelected <- LowLevel.getPush t - LowLevel.setPush t (Nothing :: (Maybe (Ref LowLevel.Widget))) - focusedWidget <- FL.focus + _ <- LowLevel.setPush t (Nothing :: (Maybe (Ref LowLevel.Widget))) case lastSelected of Nothing -> return (Right ()) Just w -> do @@ -184,8 +181,8 @@ when vf (do imFocused <- refPtrEquals w t - if imFocused then lightTabRedrawTabs spec t - else FL.setFocus(t) >> lightTabRedrawTabs spec t) + if imFocused then lightTabRedrawTabs t + else FL.setFocus(t) >> lightTabRedrawTabs t) changed <- LowLevel.setValue t lastSelected case changed of Left NoChange -> do @@ -236,7 +233,7 @@ Just (AtIndex i) -> if (i == 0) then LowLevel.handleSuper t e else - let (X x, Width w) = offsetWidths !! (i-1) + let (X x, _) = offsetWidths !! (i-1) currOffset = x - tabsX in do if (currOffset >= 0) @@ -346,7 +343,7 @@ (_,_,widths) <- lightTabPositionsCustom spec t offset <- readIORef (tabViewOffset spec) let tab = find - (\(i,(x,w)) -> insideRectangle pos (Rectangle (Position x (Y tabBarY)) (Size w (Height tabBarHeight)))) + (\(_,(x,w)) -> insideRectangle pos (Rectangle (Position x (Y tabBarY)) (Size w (Height tabBarHeight)))) (zip (map AtIndex [0 ..]) (map (\(X x, Width w) -> (X (x+offset), Width w)) widths)) cs <- LowLevel.getArray t return (fmap (\(AtIndex i, _) -> (AtIndex i,cs !! i)) tab) @@ -354,9 +351,6 @@ -- | A default 'TabSpec' tabSpec :: (?assets :: Assets) => Rectangle -> IO TabSpec tabSpec rectangle = do - let (tabsX,tabsY,tabsWidth,tabsHeight) = fromRectangle rectangle - buttonWidth = 15 - buttonHeight = 15 borderColor <- commonSelectionColor color <- commonColor offset <- newIORef 0 @@ -386,7 +380,7 @@ , LowLevel.tabPositionsCustom = lightTabPositionsCustom spec , LowLevel.tabHeightCustom = lightTabHeightCustom spec , LowLevel.tabWhichCustom = lightTabWhichCustom spec - , LowLevel.tabRedrawTabs = lightTabRedrawTabs spec + , LowLevel.tabRedrawTabs = lightTabRedrawTabs , LowLevel.tabClientArea = lightTabClientAreaCustom spec })) (Just diff --git a/src/Graphics/UI/FLTK/Theme/Light/Valuator.hs b/src/Graphics/UI/FLTK/Theme/Light/Valuator.hs --- a/src/Graphics/UI/FLTK/Theme/Light/Valuator.hs +++ b/src/Graphics/UI/FLTK/Theme/Light/Valuator.hs @@ -13,7 +13,6 @@ import qualified Data.Text as T import qualified Graphics.UI.FLTK.LowLevel.FL as FL import qualified Graphics.UI.FLTK.LowLevel.FLTKHS as LowLevel -import Graphics.UI.FLTK.LowLevel.Dispatch import Graphics.UI.FLTK.Theme.Light.Assets adjusterNew :: (?assets :: Assets) => Rectangle -> Maybe T.Text -> IO (Ref LowLevel.Adjuster)