113 lines
3.1 KiB
Haskell
113 lines
3.1 KiB
Haskell
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)
|
|
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
|
|
|
|
|
|
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
|