lang/laantas-script/Svg.hs

114 lines
3 KiB
Haskell
Raw Normal View History

2020-11-04 13:06:54 -05:00
module Svg
(module Svg,
Text, pack,
2020-11-04 13:06:54 -05:00
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)
import Data.Text (Text, pack)
2020-11-04 13:06:54 -05:00
data Env = E {width, size, stroke :: !Double}
data St = S {x, y, textWidth, textHeight :: !Double}
-- nb textHeight is one lineheight less than the actual height
2020-11-04 13:06:54 -05:00
-- 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
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