{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} module Graphics.SVGFonts.PathInRect where import Diagrams.Prelude hiding (font, text, render, width, height, envelope) data PathInRect n = PathInRect n n n n (Path V2 n) fit_height :: (RealFloat n) => n -> PathInRect n -> PathInRect n fit_height :: n -> PathInRect n -> PathInRect n fit_height n desired_height (PathInRect n x1 n y1 n x2 n y2 Path V2 n path) = n -> n -> n -> n -> Path V2 n -> PathInRect n forall n. n -> n -> n -> n -> Path V2 n -> PathInRect n PathInRect (n scale_n -> n -> n forall a. Num a => a -> a -> a *n x1) (n scale_n -> n -> n forall a. Num a => a -> a -> a *n y1) (n scale_n -> n -> n forall a. Num a => a -> a -> a *n x2) (n scale_n -> n -> n forall a. Num a => a -> a -> a *n y2) (n -> Path V2 n -> Path V2 n forall (v :: * -> *) n a. (InSpace v n a, Eq n, Fractional n, Transformable a) => n -> a -> a scale n scale_ Path V2 n path) where scale_ :: n scale_ = n desired_height n -> n -> n forall a. Fractional a => a -> a -> a / (n y2 n -> n -> n forall a. Num a => a -> a -> a - n y1) fit_width :: (RealFloat n) => n -> PathInRect n -> PathInRect n fit_width :: n -> PathInRect n -> PathInRect n fit_width n desired_width (PathInRect n x1 n y1 n x2 n y2 Path V2 n path) = n -> n -> n -> n -> Path V2 n -> PathInRect n forall n. n -> n -> n -> n -> Path V2 n -> PathInRect n PathInRect (n scale_n -> n -> n forall a. Num a => a -> a -> a *n x1) (n scale_n -> n -> n forall a. Num a => a -> a -> a *n y1) (n scale_n -> n -> n forall a. Num a => a -> a -> a *n x2) (n scale_n -> n -> n forall a. Num a => a -> a -> a *n y2) (n -> Path V2 n -> Path V2 n forall (v :: * -> *) n a. (InSpace v n a, Eq n, Fractional n, Transformable a) => n -> a -> a scale n scale_(Path V2 n -> Path V2 n) -> Path V2 n -> Path V2 n forall a b. (a -> b) -> a -> b $ Path V2 n path) where scale_ :: n scale_ = n desired_width n -> n -> n forall a. Fractional a => a -> a -> a / (n x2 n -> n -> n forall a. Num a => a -> a -> a - n x1) set_envelope :: forall b n. (TypeableFloat n, Renderable (Path V2 n) b) => PathInRect n -> QDiagram b V2 n Any set_envelope :: PathInRect n -> QDiagram b V2 n Any set_envelope (PathInRect n x1 n y1 n x2 n y2 Path V2 n path) = Path V2 n path Path V2 n -> (Path V2 n -> QDiagram b V2 n Any) -> QDiagram b V2 n Any forall a b. a -> (a -> b) -> b # Path V2 n -> QDiagram b V2 n Any forall n t b. (InSpace V2 n t, ToPath t, TypeableFloat n, Renderable (Path V2 n) b) => t -> QDiagram b V2 n Any stroke QDiagram b V2 n Any -> (QDiagram b V2 n Any -> QDiagram b V2 n Any) -> QDiagram b V2 n Any forall a b. a -> (a -> b) -> b # D V2 n -> QDiagram b V2 n Any -> QDiagram b V2 n Any forall (v :: * -> *) n a m b. (InSpace v n a, Monoid' m, Enveloped a) => a -> QDiagram b v n m -> QDiagram b v n m withEnvelope D V2 n envelope where envelope :: D V2 n envelope :: D V2 n envelope = Vn (D V2 n) -> D V2 n -> D V2 n forall t. Transformable t => Vn t -> t -> t translate ((n, n) -> V2 n forall n. (n, n) -> V2 n r2 (n widthn -> n -> n forall a. Fractional a => a -> a -> a /n 2 n -> n -> n forall a. Num a => a -> a -> a + n x1, n heightn -> n -> n forall a. Fractional a => a -> a -> a /n 2 n -> n -> n forall a. Num a => a -> a -> a + n y1))(D V2 n -> D V2 n) -> D V2 n -> D V2 n forall a b. (a -> b) -> a -> b $ n -> n -> D V2 n forall n t. (InSpace V2 n t, TrailLike t) => n -> n -> t rect n width n height height :: n height = n y2 n -> n -> n forall a. Num a => a -> a -> a - n y1 width :: n width = n x2 n -> n -> n forall a. Num a => a -> a -> a - n x1 drop_rect :: forall n. (RealFloat n) => PathInRect n -> Path V2 n drop_rect :: PathInRect n -> Path V2 n drop_rect (PathInRect n _ n _ n _ n _ Path V2 n path) = Path V2 n path