module MeterF where
import AllFudgets
import Data.Ratio

meterF :: RealFrac v => InF v (Ratio Int) -- because of the monomorphism restr
meterF :: InF v (Ratio Int)
meterF = (GraphicsF FlexibleDrawing -> GraphicsF FlexibleDrawing)
-> InF v (Ratio Int)
forall a1.
RealFrac a1 =>
(GraphicsF FlexibleDrawing -> GraphicsF FlexibleDrawing)
-> F a1 (InputMsg (Ratio Int))
meterF' GraphicsF FlexibleDrawing -> GraphicsF FlexibleDrawing
forall a. Customiser a
standard

meterF' :: (GraphicsF FlexibleDrawing -> GraphicsF FlexibleDrawing)
-> F a1 (InputMsg (Ratio Int))
meterF' GraphicsF FlexibleDrawing -> GraphicsF FlexibleDrawing
pm =
   SP (GfxEvent DPath) (InputMsg (Ratio Int))
forall a. SP (GfxEvent a) (InputMsg (Ratio Int))
post SP (GfxEvent DPath) (InputMsg (Ratio Int))
-> F (Either Bool (GfxFCmd FlexibleDrawing)) (GfxEvent DPath)
-> F (Either Bool (GfxFCmd FlexibleDrawing)) (InputMsg (Ratio Int))
forall a b e. SP a b -> F e a -> F e b
>^^=< Bool
-> Int
-> F (GfxFCmd FlexibleDrawing) (GfxEvent DPath)
-> F (Either Bool (GfxFCmd FlexibleDrawing)) (GfxEvent DPath)
forall a b. Bool -> Int -> F a b -> F (Either Bool a) b
border3dF Bool
True Int
1 ((GraphicsF FlexibleDrawing -> GraphicsF FlexibleDrawing)
-> F (GfxFCmd FlexibleDrawing) (GfxEvent DPath)
forall gfx.
Graphic gfx =>
Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) (GfxEvent DPath)
graphicsDispF' GraphicsF FlexibleDrawing -> GraphicsF FlexibleDrawing
params) F (Either Bool (GfxFCmd FlexibleDrawing)) (InputMsg (Ratio Int))
-> (a1 -> Either Bool (GfxFCmd FlexibleDrawing))
-> F a1 (InputMsg (Ratio Int))
forall c d e. F c d -> (e -> c) -> F e d
>=^< a1 -> Either Bool (GfxFCmd FlexibleDrawing)
forall a a. a1 -> Either a (GfxCommand [a] FlexibleDrawing)
pre
 where
   params :: GraphicsF FlexibleDrawing -> GraphicsF FlexibleDrawing
params = GraphicsF FlexibleDrawing -> GraphicsF FlexibleDrawing
pm (GraphicsF FlexibleDrawing -> GraphicsF FlexibleDrawing)
-> (GraphicsF FlexibleDrawing -> GraphicsF FlexibleDrawing)
-> GraphicsF FlexibleDrawing
-> GraphicsF FlexibleDrawing
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	    --setSizing Static .
	    --setGfxEventMask [GfxButtonMask,GfxDragMask] .
	    ColorSpec -> GraphicsF FlexibleDrawing -> GraphicsF FlexibleDrawing
forall xxx a.
(HasBgColorSpec xxx, Show a, ColorGen a) =>
a -> Customiser xxx
setBgColor ColorSpec
meterBg (GraphicsF FlexibleDrawing -> GraphicsF FlexibleDrawing)
-> (GraphicsF FlexibleDrawing -> GraphicsF FlexibleDrawing)
-> GraphicsF FlexibleDrawing
-> GraphicsF FlexibleDrawing
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	    ColorSpec -> GraphicsF FlexibleDrawing -> GraphicsF FlexibleDrawing
forall xxx. HasFgColorSpec xxx => ColorSpec -> Customiser xxx
setFgColorSpec ColorSpec
meterFg (GraphicsF FlexibleDrawing -> GraphicsF FlexibleDrawing)
-> (GraphicsF FlexibleDrawing -> GraphicsF FlexibleDrawing)
-> GraphicsF FlexibleDrawing
-> GraphicsF FlexibleDrawing
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	    Int -> GraphicsF FlexibleDrawing -> GraphicsF FlexibleDrawing
forall xxx. HasBorderWidth xxx => Int -> Customiser xxx
setBorderWidth Int
0
   pre :: a1 -> Either a (GfxCommand [a] FlexibleDrawing)
pre = GfxCommand [a] FlexibleDrawing
-> Either a (GfxCommand [a] FlexibleDrawing)
forall a b. b -> Either a b
Right (GfxCommand [a] FlexibleDrawing
 -> Either a (GfxCommand [a] FlexibleDrawing))
-> (a1 -> GfxCommand [a] FlexibleDrawing)
-> a1
-> Either a (GfxCommand [a] FlexibleDrawing)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlexibleDrawing -> GfxCommand [a] FlexibleDrawing
forall gfx a. gfx -> GfxCommand [a] gfx
replaceAllGfx (FlexibleDrawing -> GfxCommand [a] FlexibleDrawing)
-> (a1 -> FlexibleDrawing) -> a1 -> GfxCommand [a] FlexibleDrawing
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a1 -> FlexibleDrawing
forall a1. RealFrac a1 => a1 -> FlexibleDrawing
meterD
   post :: SP (GfxEvent a) (InputMsg (Ratio Int))
post = (GfxEvent a -> Maybe (InputMsg (Ratio Int)))
-> SP (GfxEvent a) (InputMsg (Ratio Int))
forall t b. (t -> Maybe b) -> SP t b
mapFilterSP GfxEvent a -> Maybe (InputMsg (Ratio Int))
forall a. GfxEvent a -> Maybe (InputMsg (Ratio Int))
pick
   pick :: GfxEvent a -> Maybe (InputMsg (Ratio Int))
pick (GfxButtonEvent {gfxType :: forall path. GfxEvent path -> Pressed
gfxType=Pressed
Pressed,gfxPaths :: forall path. GfxEvent path -> [(path, (Point, Rect))]
gfxPaths=(a, (Point, Rect))
p:[(a, (Point, Rect))]
_}) = (a, (Point, Rect)) -> Maybe (InputMsg (Ratio Int))
forall a. (a, (Point, Rect)) -> Maybe (InputMsg (Ratio Int))
change (a, (Point, Rect))
p
   pick (GfxButtonEvent {gfxType :: forall path. GfxEvent path -> Pressed
gfxType=Pressed
Released,gfxPaths :: forall path. GfxEvent path -> [(path, (Point, Rect))]
gfxPaths=(a, (Point, Rect))
p:[(a, (Point, Rect))]
_}) = (a, (Point, Rect)) -> Maybe (InputMsg (Ratio Int))
forall a. (a, (Point, Rect)) -> Maybe (InputMsg (Ratio Int))
done (a, (Point, Rect))
p
   pick (GfxMotionEvent {gfxPaths :: forall path. GfxEvent path -> [(path, (Point, Rect))]
gfxPaths=(a, (Point, Rect))
p:[(a, (Point, Rect))]
_}) = (a, (Point, Rect)) -> Maybe (InputMsg (Ratio Int))
forall a. (a, (Point, Rect)) -> Maybe (InputMsg (Ratio Int))
change (a, (Point, Rect))
p
   pick GfxEvent a
_ = Maybe (InputMsg (Ratio Int))
forall a. Maybe a
Nothing
   change :: (a, (Point, Rect)) -> Maybe (InputMsg (Ratio Int))
change = InputMsg (Ratio Int) -> Maybe (InputMsg (Ratio Int))
forall a. a -> Maybe a
Just (InputMsg (Ratio Int) -> Maybe (InputMsg (Ratio Int)))
-> ((a, (Point, Rect)) -> InputMsg (Ratio Int))
-> (a, (Point, Rect))
-> Maybe (InputMsg (Ratio Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ratio Int -> InputMsg (Ratio Int)
forall a. a -> InputMsg a
inputChange (Ratio Int -> InputMsg (Ratio Int))
-> ((a, (Point, Rect)) -> Ratio Int)
-> (a, (Point, Rect))
-> InputMsg (Ratio Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, (Point, Rect)) -> Ratio Int
forall a. (a, (Point, Rect)) -> Ratio Int
extr
   done :: (a, (Point, Rect)) -> Maybe (InputMsg (Ratio Int))
done = InputMsg (Ratio Int) -> Maybe (InputMsg (Ratio Int))
forall a. a -> Maybe a
Just (InputMsg (Ratio Int) -> Maybe (InputMsg (Ratio Int)))
-> ((a, (Point, Rect)) -> InputMsg (Ratio Int))
-> (a, (Point, Rect))
-> Maybe (InputMsg (Ratio Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ratio Int -> InputMsg (Ratio Int)
forall a. a -> InputMsg a
inputMsg (Ratio Int -> InputMsg (Ratio Int))
-> ((a, (Point, Rect)) -> Ratio Int)
-> (a, (Point, Rect))
-> InputMsg (Ratio Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, (Point, Rect)) -> Ratio Int
forall a. (a, (Point, Rect)) -> Ratio Int
extr
   extr :: (a, (Point, Rect)) -> Ratio Int
extr (a
_,(Point
p,Rect Point
p0 Point
s)) = Point -> Int
xcoord (Point
pPoint -> Point -> Point
forall a. Num a => a -> a -> a
-Point
p0) Int -> Int -> Ratio Int
forall a. Integral a => a -> a -> Ratio a
% Point -> Int
xcoord Point
s

meterD :: a1 -> FlexibleDrawing
meterD a1
r = Point -> Bool -> Bool -> (Rect -> [DrawCommand]) -> FlexibleDrawing
FlexD (Int -> Int -> Point
Point Int
50 Int
5) Bool
False Bool
True Rect -> [DrawCommand]
drawfun
  where
    drawfun :: Rect -> [DrawCommand]
drawfun (Rect Point
p (Point Int
w Int
h)) = [Rect -> DrawCommand
FillRectangle (Point -> Point -> Rect
Rect Point
p (Int -> Int -> Point
Point Int
w' Int
h))]
      where w' :: Int
w' = a1 -> Int -> Int
forall a1 b a2.
(RealFrac a1, Integral b, Integral a2) =>
a1 -> a2 -> b
scale a1
r Int
w

meterFg :: ColorSpec
meterFg = [[Char]] -> ColorSpec
forall a. (Show a, ColorGen a) => a -> ColorSpec
colorSpec ([[Char]] -> ColorSpec) -> [[Char]] -> ColorSpec
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [[Char]]
argKeyList [Char]
"meterfg" [[Char]
"blue2",[Char]
fgColor,[Char]
"black"]
meterBg :: ColorSpec
meterBg = [[Char]] -> ColorSpec
forall a. (Show a, ColorGen a) => a -> ColorSpec
colorSpec ([[Char]] -> ColorSpec) -> [[Char]] -> ColorSpec
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [[Char]]
argKeyList [Char]
"meterbg" [[Char]
bgColor,[Char]
"white"]