make laantas-script usable as a library

laantas-script/lib/Svg.hs

@@ -0,0 +1,136 @@
+module Svg
+  (module Svg,
+   Text, pack,
+   module Graphics.Svg,
+   module Control.Monad.Reader,
+   module Control.Monad.State)
+where
+
+import Control.Monad.Reader
+import Control.Monad.State
+import qualified Graphics.Svg as Base
+import Graphics.Svg
+  hiding (mA, mR, lA, lR, cA, cR, sA, sR, aA, aR, qA, qR, tA, tR)
+import Data.Text (Text, pack)
+
+
+data Env = E {width, size, stroke :: !Double, color :: !Text}
+data St = S {x, y, textWidth, textHeight :: !Double, firstOnLine :: Bool}
+-- nb textHeight is one lineheight less than the actual height
+-- unless ending with a 'newline'
+
+type M = ReaderT Env (State St)
+
+type Point = (Double, Double)
+
+
+mA :: Point -> M Text
+mA (x', y') =
+  ReaderT \E {size} -> gets \S {x, y} ->
+    Base.mA (x + x' * size) (y + y' * size)
+
+mR :: Point -> M Text
+mR (x', y') = reader \E {size} -> Base.mR (x' * size) (y' * size)
+
+lA :: Point -> M Text
+lA (x', y') =
+  ReaderT \E {size} -> gets \S {x, y} ->
+    Base.lA (x + x' * size) (y + y' * size)
+
+lR :: Point -> M Text
+lR (x', y') = reader \E {size} -> Base.lR (x' * size) (y' * size)
+
+sA :: Point -> Point -> M Text
+sA (x1, y1) (x2, y2) =
+  ReaderT \E {size} -> gets \S {x, y} ->
+    Base.sA (x + x1 * size) (y + y1 * size)
+            (x + x2 * size) (y + y2 * size)
+
+sR :: Point -> Point -> M Text
+sR (x1, y1) (x2, y2) =
+  reader \E {size} ->
+    Base.sR (x1 * size) (y1 * size) (x2 * size) (y2 * size)
+
+cA :: Point -> Point -> Point -> M Text
+cA (x1, y1) (x2, y2) (x3, y3) =
+  ReaderT \E {size} -> gets \S {x, y} ->
+    Base.cA (x + x1 * size) (y + y1 * size)
+            (x + x2 * size) (y + y2 * size)
+            (x + x3 * size) (y + y3 * size)
+    <> " " -- lmao
+
+cR :: Point -> Point -> Point -> M Text
+cR (x1, y1) (x2, y2) (x3, y3) =
+  reader \E {size} ->
+    Base.cR (x1 * size) (y1 * size)
+            (x2 * size) (y2 * size)
+            (x3 * size) (y3 * size)
+    <> " " -- lmao
+
+qA :: Point -> Point -> M Text
+qA (x1, y1) (x2, y2) =
+  reader \E {size} ->
+    Base.qA (x1 * size) (y1 * size)
+            (x2 * size) (y2 * size)
+
+qR :: Point -> Point -> M Text
+qR (x1, y1) (x2, y2) =
+  reader \E {size} ->
+    Base.qR (x1 * size) (y1 * size)
+            (x2 * size) (y2 * size)
+
+tA :: Point -> M Text
+tA (x1, y1) =
+  reader \E {size} ->
+    Base.tA (x1 * size) (y1 * size)
+
+tR :: Point -> M Text
+tR (x1, y1) =
+  reader \E {size} ->
+    Base.tR (x1 * size) (y1 * size)
+
+
+data Arc = Large | Small
+data Sweep = CW | CCW
+
+arcToFlag :: Num a => Arc -> a
+arcToFlag = \case Large -> 1; Small -> 0
+
+sweepToFlag :: Num a => Sweep -> a
+sweepToFlag = \case CW -> 1; CCW -> 0
+
+aA :: Double -> Double -> Double -> Arc -> Sweep -> Point -> M Text
+aA rx ry θ arc sweep (x', y') =
+  ReaderT \E {size} -> gets \S {x, y} ->
+    Base.aA (rx * size) (ry * size) θ (arcToFlag arc) (sweepToFlag sweep)
+            (x + x' * size) (y + y' * size)
+
+aR :: Double -> Double -> Double -> Arc -> Sweep -> Point -> M Text
+aR rx ry θ arc sweep (x', y') =
+  reader \E {size} ->
+    Base.aR (rx * size) (ry * size) θ (arcToFlag arc) (sweepToFlag sweep)
+            (x' * size) (y' * size)
+
+ellipseX :: (Point -> M Text) -> Double -> Double -> Point -> [M Text]
+ellipseX mX rx ry (x', y') =
+  [mX (x' - rx, y'), aR rx ry 0 Large CW (0,0.0001), pure z]
+
+ellipseR, ellipseA :: Double -> Double -> Point -> [M Text]
+ellipseR = ellipseX mR
+ellipseA = ellipseX mA
+
+circR :: Double -> Point -> [M Text]
+circR r = ellipseR r r
+
+circA :: Double -> Point -> [M Text]
+circA r = ellipseA r r
+
+
+shiftX :: Double -> St -> St
+shiftX dx s@(S {x}) = s {x = x + dx}
+
+shiftY :: Double -> St -> St
+shiftY dy s@(S {y}) = s {y = y + dy}
+
+shift :: (Double, Double) -> St -> St
+shift (dx, dy) = shiftX dx . shiftY dy