widget coordinates are now local (offset based on parent component)

src/UI/Callbacks.hs

@@ -19,13 +19,13 @@ import Types
 import UI.UIWidgets
 import UI.UIOperations
 
-
+-- TODO: define GUI positions in a file
 createGUI :: (Map.HashMap UIId (GUIWidget Pioneers), [UIId])
 createGUI = (Map.fromList [ (UIId 0, createPanel (0, 0, 0, 0) [UIId 1, UIId 2] 0)
-                          , (UIId 1, createContainer (20, 50, 120, 80) [] 1)
+                          , (UIId 1, createContainer (30, 215, 100, 80) [] 1)
-                          , (UIId 2, createPanel (100, 140, 0, 0) [UIId 3, UIId 4] 3)
+                          , (UIId 2, createPanel (50, 40, 0, 0) [UIId 3, UIId 4] 3)
-                          , (UIId 3, createContainer (100, 140, 130, 200) [] 4 )
+                          , (UIId 3, createContainer (80, 15, 130, 90) [] 4 )
-                          , (UIId 4, createButton (30, 200, 60, 175) 2 testMessage)
+                          , (UIId 4, createButton (10, 40, 60, 130) 2 testMessage)
                           ], [UIId 0])
          
 getGUI :: Map.HashMap UIId (GUIWidget Pioneers) -> [GUIWidget Pioneers]
@@ -89,12 +89,12 @@ eventCallback e = do
                         modify $ aks.down  .~ (movement == SDL.KeyDown)
                     SDL.KeypadPlus ->
                         when (movement == SDL.KeyDown) $ do
-                            modify $ (gl.glMap.stateTessellationFactor) %~ ((min 5) . (+1))
+                            modify $ gl.glMap.stateTessellationFactor %~ (min 5) . (+1)
                             state <- get
                             liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ state ^. gl.glMap.stateTessellationFactor]
                     SDL.KeypadMinus ->
                         when (movement == SDL.KeyDown) $ do
-                            modify $ (gl.glMap.stateTessellationFactor) %~ ((max 1) . (+(-1)))
+                            modify $ gl.glMap.stateTessellationFactor %~ (max 1) . (+(-1))
                             state <- get
                             liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ state ^. gl.glMap.stateTessellationFactor]
                     _ ->
@@ -104,13 +104,13 @@ eventCallback e = do
                 state <- get
                 when (state ^. mouse.isDown && not (state ^. mouse.isDragging)) $
                     modify $ (mouse.isDragging .~ True)
-                           . (mouse.dragStartX .~ (fromIntegral x))
+                           . (mouse.dragStartX .~ fromIntegral x)
-                           . (mouse.dragStartY .~ (fromIntegral y))
+                           . (mouse.dragStartY .~ fromIntegral y)
                            . (mouse.dragStartXAngle .~ (state ^. camera.xAngle))
                            . (mouse.dragStartYAngle .~ (state ^. camera.yAngle))
 
-                modify $ (mouse.mousePosition. Types._x .~ (fromIntegral x))
+                modify $ (mouse.mousePosition. Types._x .~ fromIntegral x)
-                       . (mouse.mousePosition. Types._y .~ (fromIntegral y))
+                       . (mouse.mousePosition. Types._y .~ fromIntegral y)
             SDL.MouseButton _ _ button state (SDL.Position x y) -> -- windowID mouseID button buttonState buttonAt
                 case button of
                     SDL.LeftButton -> do
@@ -122,7 +122,7 @@ eventCallback e = do
                                 modify $ mouse.isDragging .~ False
                             else
                                 clickHandler LeftButton (x, y)
-                    _ -> do when (state == SDL.Released)
+                    _ -> when (state == SDL.Released)
                                 $ maybe (return ()) (`clickHandler` (x, y)) $ transformButton button
             SDL.MouseWheel _ _ _ vscroll -> -- windowID mouseID hScroll vScroll
                 do
@@ -181,12 +181,14 @@ prepareGUI = do
                 liftIO $ do
                     -- bind texture - all later calls work on this one.
                     GL.textureBinding GL.Texture2D GL.$= Just tex
-                mapM_ (copyGUI tex) roots
+                mapM_ (copyGUI tex (0, 0)) roots
                 modify $ ui.uiHasChanged .~ False
 
 --TODO: Perform border-checking ... is xoff + width and yoff+height inside the screen-coordinates..
-copyGUI :: GL.TextureObject -> GUIWidget Pioneers -> Pioneers ()
+copyGUI :: GL.TextureObject -> Pixel -- ^current view's offset
-copyGUI tex widget = do
+        -> GUIWidget Pioneers -- ^the widget to draw
+        -> Pioneers ()
+copyGUI tex (vX, vY) widget = do
                         (xoff, yoff, wWidth, wHeight) <- widget ^. baseProperties.boundary
                         state <- get
                         let 
@@ -205,11 +207,11 @@ copyGUI tex widget = do
                                 GL.texSubImage2D
                                         GL.Texture2D
                                         0
-                                        (GL.TexturePosition2D (int xoff) (int yoff))
+                                        (GL.TexturePosition2D (int (vX + xoff)) (int (vY + yoff)))
                                         (GL.TextureSize2D (int wWidth) (int wHeight))
                                         (GL.PixelData GL.RGBA GL.UnsignedByte ptr)
                         nextChildrenIds <- widget ^. baseProperties.children
-                        mapM_ (copyGUI tex) $ toGUIAnys hMap $ nextChildrenIds
+                        mapM_ (copyGUI tex (vX+xoff, vY+yoff)) $ toGUIAnys hMap nextChildrenIds
 
 --TODO: Add scroll-Handler, return (Pioneers Bool) to indicate event-bubbling etc.
 --TODO: Maybe queues are better?

src/UI/UIBase.hs

@@ -17,6 +17,31 @@ type ScreenUnit = Int
 -- | @x@ and @y@ position on screen. 
 type Pixel = (ScreenUnit, ScreenUnit)
 
+-- |Combines two tuples element-wise. Designed for use with 'Pixel'.
+merge :: (a -> b -> c) -> (a, a) -> (b, b) -> (c, c)
+merge f (x, y) (x', y') = (f x x', f y y')
+{-# INLINABLE merge #-}
+
+-- |Maps the over the elements of a tuple. Designed for use with 'Pixel'.
+(>:) :: (a -> b) -> (a, a) -> (b, b)
+f >: (x, y) = (f x, f y)
+{-# INLINABLE (>:) #-}
+
+-- |Adds two numeric tuples component-wise.
+(+:) :: (Num a) => (a, a) -> (a, a) -> (a, a)
+(+:) = merge (+)
+{-# INLINABLE (+:) #-}
+
+-- |Calculates the component-wise difference between two tuples.
+(-:) :: (Num a) => (a, a) -> (a, a) -> (a, a)
+(-:) = merge (-)
+{-# INLINABLE (-:) #-}
+
+-- |Multiplies two numeric tuples component-wise.
+(*:) :: (Num a) => (a, a) -> (a, a) -> (a, a)
+(*:) = merge (*)
+{-# INLINABLE (*:) #-}
+
 newtype UIId = UIId Int deriving (Eq, Ord, Bounded, Ix, Hashable, Show, Read)
 
 data MouseButton = LeftButton | RightButton | MiddleButton | MouseX1 | MouseX2
@@ -229,4 +254,3 @@ debugShowWidget' (Widget base mouse _) = do
     let short = base ^. shorthand
     return $ concat [short,"| boundary:", show bnd, ", children:", show chld,
                     ",priority:",show prio, maybe "" (const ", with mouse handler") mouse]
-    

src/UI/UIOperations.hs

@@ -8,41 +8,18 @@ import           Data.Maybe
 import Types
 import UI.UIBase
 
+-- TODO: test GUI function to scan for overlapping widgets
+
 toGUIAny :: Map.HashMap UIId (GUIWidget m) -> UIId -> GUIWidget m
 toGUIAny m uid = fromMaybe (error "map does not contain requested key") (Map.lookup uid m)
-{-# INLINE toGUIAny #-}
+{-# INLINABLE toGUIAny #-}
 
 toGUIAnys :: Map.HashMap UIId (GUIWidget m) -> [UIId] -> [GUIWidget m]
 toGUIAnys m = mapMaybe (`Map.lookup` m)
-{-# INLINE toGUIAnys #-}
+{-# INLINABLE toGUIAnys #-}
 -- TODO: check for missing components?
 
 
--- |The function 'getInside' returns child widgets that overlap with a specific
---  screen position.
---  
---  A screen position may be inside the bounding box of a widget but not
---  considered part of the component. The function returns all hit widgets that 
---  have no hit children, which may be the input widget itself,
---  or @[]@ if the point does not hit the widget.
---  
---  This function returns the widgets themselves unlike 'getInsideId'.
-getInside :: Map.HashMap UIId (GUIWidget Pioneers) -- ^map containing ui widgets
-          -> Pixel  -- ^screen position
-          -> GUIWidget Pioneers  -- ^the parent widget
-          -> Pioneers [GUIWidget Pioneers]
-getInside hMap px wg = do
-  inside <- (wg ^. baseProperties.isInside) wg px
-  if inside -- test inside parent's bounding box
-  then do
-       childrenIds <- wg ^. baseProperties.children
-       hitChildren <- liftM concat $ mapM (getInside hMap px) (toGUIAnys hMap childrenIds)
-       case hitChildren of
-            [] -> return [wg]
-            _  -> return hitChildren
-  else return []
---TODO: Priority queue?
-
 -- |The function 'getInsideId' returns child widgets that overlap with a 
 --  specific screen position.
 --  
@@ -50,19 +27,18 @@ getInside hMap px wg = do
 --  considered part of the component. The function returns all hit widgets that 
 --  have no hit children, which may be the input widget itself,
 --  or @[]@ if the point does not hit the widget.
---  
---  This function returns the 'UIId's of the widgets unlike 'getInside'.
 getInsideId :: Map.HashMap UIId (GUIWidget Pioneers) -- ^map containing ui widgets
             -> Pixel  -- ^screen position
             -> UIId  -- ^the parent widget
             -> Pioneers [UIId]
 getInsideId hMap px uid = do
   let wg = toGUIAny hMap uid
-  inside <- (wg ^. baseProperties.isInside) wg px
+  bnd@(bX, bY, _, _) <- wg ^. baseProperties.boundary
+  inside <- liftM (isInsideRect bnd px &&) $ (wg ^. baseProperties.isInside) wg px
   if inside -- test inside parent's bounding box
     then do
       childrenIds <- wg ^. baseProperties.children
-      hitChildren <- liftM concat $ mapM (getInsideId hMap px) childrenIds
+      hitChildren <- liftM concat $ mapM (getInsideId hMap (px -: (bX, bY))) childrenIds
       case hitChildren of
            [] -> return [uid]
            _  -> return hitChildren

src/UI/UIWidgets.hs

@@ -29,14 +29,8 @@ createPanel bnd chld prio = Widget (rectangularBase bnd chld prio "PNL" & bounda
     autosize' = do
         state <- get
         let hmap = state ^. ui . uiMap
-            -- TODO: local coordinates
             determineSize' :: (ScreenUnit, ScreenUnit, ScreenUnit ,ScreenUnit) -> (ScreenUnit, ScreenUnit, ScreenUnit ,ScreenUnit) -> (ScreenUnit, ScreenUnit, ScreenUnit ,ScreenUnit)
-            determineSize' (x, y, w, h) (x', y', w', h') =
+            determineSize' (x, y, w, h) (x', y', w', h') = (x, y, max w (x' + w'), max h (y' + h'))
-               let x'' = if x' < x then x' else x
-                   y'' = if y' < y then y' else y
-                   w'' = if x' + w' > x + w then x' + w' - x'' else x + w - x''
-                   h'' = if y' + h' > y + h then y' + h' - y'' else y + h - y''
-                in (x'', y'', w'', h'')
         case chld of
              [] -> return bnd
              cs -> do let widgets = mapMaybe (`Map.lookup` hmap) cs