Some more work on the taskbar

1 files changed, 38 insertions, 31 deletions

diff --git a/lib/Phi/Border.hs b/lib/Phi/Border.hs
index 1994724..0576f27 100644
--- a/lib/Phi/Border.hs
+++ b/lib/Phi/Border.hs
@@ -4,6 +4,8 @@ module Phi.Border ( BorderWidth(..)
                   , simpleBorderWidth
                   , BorderConfig(..)
                   , defaultBorderConfig
+                  , drawBorder
+                  , roundRectangle
                   , border
                   ) where
 
@@ -76,41 +78,46 @@ instance WidgetClass Border where
       height' = height - borderV m - 2*bw - borderV p
 
   render (Border config _) (BorderState widgetStates) w h = do
-    newPath
-    arc (x + width - radius) (y + radius) radius (-pi/2) 0
-    arc (x + width - radius) (y + height - radius) radius 0 (pi/2)
-    arc (x + radius) (y + height - radius) radius (pi/2) pi
-    arc (x + radius) (y + radius) radius  pi (pi*3/2)
-    closePath
-    
-    save
-    setSourceRGBA fr fg fb fa
-    fillPreserve
-    
-    setSourceRGBA br bg bb ba
-    setLineWidth $ fromIntegral bw
-    strokePreserve
-    restore
-    
+    drawBorder config 0 0 w h
     clip
     renderWidgets widgetStates
     
-      where
-        m = margin config
-        bw = borderWidth config
-        p = padding config
-        radius = cornerRadius config
-        
-        x = (fromIntegral $ borderLeft m) + (fromIntegral bw)/2
-        y = (fromIntegral $ borderTop m) + (fromIntegral bw)/2
-        width = fromIntegral $ w - borderH m - bw
-        height = fromIntegral $ h - borderV m - bw
-        
-        (br, bg, bb, ba) = borderColor config
-        (fr, fg, fb, fa) = backgroundColor config
-  
   handleMessage _ (BorderState widgetStates) m = BorderState $ handleMessageWidgets m widgetStates
-    
+
+drawBorder :: BorderConfig -> Int -> Int -> Int -> Int -> Render ()
+drawBorder config dx dy w h = do
+  roundRectangle x y width height radius
+  
+  save
+  setSourceRGBA fr fg fb fa
+  fillPreserve
+  
+  setSourceRGBA br bg bb ba
+  setLineWidth $ fromIntegral bw
+  strokePreserve
+  restore
+    where
+      m = margin config
+      bw = borderWidth config
+      p = padding config
+      radius = cornerRadius config
+      
+      x = (fromIntegral dx) + (fromIntegral $ borderLeft m) + (fromIntegral bw)/2
+      y = (fromIntegral dy) + (fromIntegral $ borderTop m) + (fromIntegral bw)/2
+      width = fromIntegral $ w - borderH m - bw
+      height = fromIntegral $ h - borderV m - bw
+      
+      (br, bg, bb, ba) = borderColor config
+      (fr, fg, fb, fa) = backgroundColor config
+
+roundRectangle :: Double -> Double -> Double -> Double -> Double -> Render ()
+roundRectangle x y width height radius = do
+  newPath
+  arc (x + width - radius) (y + radius) radius (-pi/2) 0
+  arc (x + width - radius) (y + height - radius) radius 0 (pi/2)
+  arc (x + radius) (y + height - radius) radius (pi/2) pi
+  arc (x + radius) (y + radius) radius  pi (pi*3/2)
+  closePath
 
 border :: BorderConfig -> [Widget] -> Widget
 border config widgets = Widget $ Border config widgets