Matrix transforms

CHANGELOG.md

@@ -43,6 +43,8 @@
 - Fixed CSS issues: modal padding, "and/or" centering, and FCE Count arrow alignment
 - ⁠Fixed issue with "Info" popup disappearing when hovering over it and reduced the delay before it disappears
 - ⁠Fixed issue where scrolling in the course modal triggered graph zoom
+- Added parsers for all SVG transformations in `App/Svg/Parser`
+- Fixed matrix transformation and intersection checking bug when sending graph data to front end
 
 ## [0.6.0] - 2024-06-24
 

app/Database/Tables.hs

@@ -101,6 +101,7 @@ Text json
     align T.Text
     fill T.Text
     deriving Show
+    transform [Double] default=[1,0,0,1,0,0]
 
 Shape json
     graph GraphId
@@ -113,6 +114,7 @@ Shape json
     text [Text]
     type_ ShapeType
     deriving Show
+    transform [Double] default=[1,0,0,1,0,0]
 
 Path json
     graph GraphId
@@ -124,6 +126,7 @@ Path json
     source T.Text
     target T.Text
     deriving Show
+    transform [Double] default=[1,0,0,1,0,0]
 
 Post
     name PostType

app/Svg/Builder.hs

@@ -22,6 +22,7 @@ import Data.List (find)
 import qualified Data.Text as T
 import Database.DataType
 import Database.Tables hiding (shapes, texts)
+import Svg.Parser (matrixPointMultiply)
 
 -- * Builder functions
 
@@ -49,8 +50,7 @@ buildPath rects ellipses entity elementId
                       else pathSource entity
               targetNode =
                   if T.null $ pathTarget entity
-                      then getIntersectingShape end
-                               (filter (\r -> shapeId_ r /= sourceNode) nodes)
+                      then getIntersectingShape end (filter (\r -> shapeId_ r /= sourceNode) nodes)
                       else pathTarget entity
           in
               entity {pathId_ = T.pack $ 'p' : show elementId,
@@ -64,13 +64,14 @@ buildRect :: [Text]  -- ^ A list of shapes that may intersect with the given nod
           -> Integer -- ^ An integer to uniquely identify the shape
           -> Shape
 buildRect texts entity elementId =
-    let rectTexts = filter (intersects
-                            (shapeWidth entity)
-                            (shapeHeight entity)
-                            (shapePos entity)
-                            0  -- no tolerance for text intersection
-                            . textPos
-                            ) texts
+    let rectTexts = filter
+                (\text -> intersects
+                    (shapeWidth entity)
+                    (shapeHeight entity)
+                    (matrixPointMultiply (listToMatrix $ shapeTransform entity) (shapePos entity))
+                    0  -- no tolerance for text intersection
+                    (matrixPointMultiply (listToMatrix $ textTransform text) (textPos text))
+                ) texts
         textString = T.concat $ map textText rectTexts
         id_ = case shapeType_ entity of
               Hybrid -> T.pack $ 'h' : show elementId
@@ -91,13 +92,17 @@ buildEllipses :: [Text]  -- ^ A list of Text elements that may or may not inters
               -> Integer -- ^ A number to use in the ID of the ellipse.
               -> Shape
 buildEllipses texts entity elementId =
-    let ellipseText = filter (intersectsEllipse
-                              (shapeWidth entity / 2)
-                              (shapeHeight entity / 2)
-                              (fst (shapePos entity) - shapeWidth entity / 2,
-                               snd (shapePos entity) - shapeHeight entity / 2)
-                              . textPos
-                              ) texts
+    let ellipseText = filter
+                    (\text -> intersectsEllipse
+                        (shapeWidth entity / 2)
+                        (shapeHeight entity / 2)
+                        (matrixPointMultiply
+                            (listToMatrix $ shapeTransform entity)
+                            (fst (shapePos entity) - shapeWidth entity / 2,
+                            snd (shapePos entity) - shapeHeight entity / 2)
+                        )
+                        (matrixPointMultiply (listToMatrix $ textTransform text) (textPos text))
+                    ) texts
     in
         entity {
             shapeId_ =
@@ -138,6 +143,8 @@ intersects width height (rx, ry) offset (px, py) =
         dy <= height + offset;
 
 -- | Determines if a point is contained in a shape.
+-- Assumes that the point's transformation has already been applied to point
+-- Applies the inverse transformation of the shape to the point before checking for intersection
 intersectsWithPoint :: Point -> Shape -> Bool
 intersectsWithPoint point shape
     | shapeType_ shape == BoolNode =
@@ -146,13 +153,13 @@ intersectsWithPoint point shape
                    (fst (shapePos shape) - shapeWidth shape / 2,
                     snd (shapePos shape) - shapeHeight shape / 2)
                    (shapeTolerance shape)
-                   point
+                   (matrixPointMultiply (invertMatrix3x3 (listToMatrix $ shapeTransform shape)) point)
     | otherwise =
         intersects (shapeWidth shape)
                      (shapeHeight shape)
                      (shapePos shape)
                      (shapeTolerance shape)
-                     point
+                     (matrixPointMultiply (invertMatrix3x3 (listToMatrix $ shapeTransform shape)) point)
 
 -- | Returns the ID of the first shape in a list that intersects
 -- with the given point.
@@ -163,7 +170,7 @@ getIntersectingShape point shapes =
 -- | Determines if a text intersects with any shape in a list.
 intersectsWithShape :: [Shape] -> Text -> Bool
 intersectsWithShape shapes text =
-    any (intersectsWithPoint (textPos text)) shapes
+    any (intersectsWithPoint $ matrixPointMultiply (listToMatrix $ textTransform text) (textPos text)) shapes
 
 -- ** Other helpers
 
@@ -178,3 +185,36 @@ shapeTolerance s =
   case shapeType_ s of
     BoolNode -> 20.0
     _ -> 9.0
+
+
+-- * Helpers for matrix inversion
+
+-- Invert a 3x3 matrix. Assumes that the matrix is invertible
+invertMatrix3x3 :: Matrix -> Matrix
+invertMatrix3x3 m =
+    map (map (* (1 / determinantMatrix3x3 m))) (transposeMatrix3x3 (cofactorMatrix3x3 m))
+
+-- Calculate the determinant of a 3x3 matrix
+determinantMatrix3x3 :: Matrix -> Double
+determinantMatrix3x3 [[a, b, c], [d, e, f], [g, h, i]] =
+    a * (e * i - f * h) - b * (d * i - f * g) + c * (d * h - e * g)
+determinantMatrix3x3 _ = error "Matrix must be 3x3"
+
+-- Caculate the cofactor matrix
+cofactorMatrix3x3 :: Matrix -> Matrix
+cofactorMatrix3x3 [[a, b, c], [d, e, f], [g, h, i]] =
+    [[ e * i - f * h, -(b * i - c * h),  b * f - c * e],
+     [-(d * i - f * g),  a * i - c * g, -(a * f - c * d)],
+     [ d * h - e * g, -(a * h - b * g),  a * e - b * d]]
+cofactorMatrix3x3 _ = error "Matrix must be 3x3"
+
+-- Transpose a 3x3 matrix
+transposeMatrix3x3 :: Matrix -> Matrix
+transposeMatrix3x3 [[a, b, c], [d, e, f], [g, h, i]] =
+    [[a, d, g], [b, e, h], [c, f, i]]
+transposeMatrix3x3 _ = error "Matrix must be 3x3"
+
+-- Parse transform back from the format stored in the database
+listToMatrix :: [Double] -> Matrix
+listToMatrix [a, b, c, d, e, f] = [[a, c, e], [b, d, f], [0, 0, 1]]
+listToMatrix _ = error "Expecting 6 values to fully specify a transformation"

app/Svg/Generator.hs

@@ -177,6 +177,7 @@ rectToSVG styled courseMap rect
                          _ -> ""
 
         in S.g ! A.id_ (textValue $ sanitizeId $ shapeId_ rect)
+               ! A.transform (stringValue . show . formatTransform $ shapeTransform rect)
                ! A.class_ (textValue class_)
                ! S.customAttribute "data-group" (textValue
                                                  (getArea (shapeId_ rect)))
@@ -206,6 +207,7 @@ rectToSVG styled courseMap rect
 ellipseToSVG :: Bool -> Shape -> S.Svg
 ellipseToSVG styled ellipse =
     S.g ! A.id_ (textValue (shapeId_ ellipse))
+        ! A.transform (stringValue . show . formatTransform $ shapeTransform ellipse)
         ! A.class_ "bool" $ do
             S.ellipse ! A.cx (stringValue . show . fst $ shapePos ellipse)
                       ! A.cy (stringValue . show . snd $ shapePos ellipse)
@@ -227,6 +229,7 @@ textToSVG styled type_ xPos' text =
                       then xPos
                       else xPos')
             ! A.y (stringValue $ show yPos)
+            ! A.transform (stringValue . show . formatTransform $ textTransform text)
             ! (if styled then allStyles else baseStyles)
             $ toMarkup $ textText text
     where
@@ -263,6 +266,7 @@ edgeToSVG styled path =
     S.path ! A.id_ (textValue . T.append "path" . pathId_ $ path)
            ! A.class_ "path"
            ! A.d (textValue . T.cons 'M' . buildPathString . pathPoints $ path)
+           ! A.transform (stringValue . show . formatTransform $ pathTransform path)
            ! A.markerEnd "url(#arrow)"
            ! S.customAttribute "data-source-node" (textValue $ sanitizeId
                                                           $ pathSource path)
@@ -284,6 +288,7 @@ regionToSVG styled path =
     S.path ! A.id_ (textValue $ T.append "region" (pathId_ path))
            ! A.class_ "region"
            ! A.d (textValue . T.cons 'M' . buildPathString . pathPoints $ path)
+           ! A.transform (stringValue . show . formatTransform $ pathTransform path)
            ! A.style (textValue $ T.concat ["fill:", pathFill path, ";",
                       if styled
                       then
@@ -331,3 +336,9 @@ areaMap =  M.fromList
              "csc485", "csc486"], (aiDark, "ai")),
            (["csc104", "csc120", "csc108", "csc148"], (introDark, "intro")),
            (["calc1", "calc2", "alg1", "sta1", "sta2"], (mathDark, "math"))]
+
+
+-- Format SVG transform correctly from database
+formatTransform :: [Double] -> String
+formatTransform [a, b, c, d, e, f] = "matrix(" ++ unwords (map show [a, b, c, d, e, f]) ++ ")"
+formatTransform _ = error "Transform is expected to be stored in the form [a,b,c,d,e,f]"