Parse all transform

CHANGELOG.md

@@ -39,6 +39,7 @@
 - Restructured code base for coverage reports
 - Reorganized `.cabal` file
 - Added coverage report to test suite
+- Added parsers for all SVG transformations in `App/Svg/Parser`
 
 ## [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
 
@@ -39,17 +40,18 @@ buildPath rects ellipses entity elementId
                   pathSource = "",
                   pathTarget = ""}
     | otherwise =
-          let coords = pathPoints entity
+          let trans = listToMatrix $ pathTransform entity
+              coords = pathPoints entity
               start = head coords
               end = last coords
               nodes = rects ++ ellipses
               sourceNode =
                   if T.null $ pathSource entity
-                      then getIntersectingShape start nodes
+                      then getIntersectingShape (matrixPointMultiply trans start) nodes
                       else pathSource entity
               targetNode =
                   if T.null $ pathTarget entity
-                      then getIntersectingShape end
+                      then getIntersectingShape (matrixPointMultiply trans end)
                                (filter (\r -> shapeId_ r /= sourceNode) nodes)
                       else pathTarget entity
           in
@@ -64,13 +66,20 @@ 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)
+                    (shapePos entity)
+                    0  -- no tolerance for text intersection
+                    (matrixPointMultiply 
+                        (invertMatrix3x3 (listToMatrix $ shapeTransform entity))
+                        (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 +100,20 @@ 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)
+                        (fst (shapePos entity) - shapeWidth entity / 2,
+                        snd (shapePos entity) - shapeHeight entity / 2)
+                        (matrixPointMultiply 
+                            (invertMatrix3x3 (listToMatrix $ shapeTransform entity))
+                            (matrixPointMultiply
+                                (listToMatrix $ textTransform text)
+                                (textPos text)
+                            )
+                        )
+                    ) texts
     in
         entity {
             shapeId_ =
@@ -138,6 +154,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 +164,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 +181,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 +196,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]"