lang/laantas-script/Svg.hs

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