{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
module Diagrams.Backend.PGF.Hbox
( Hbox (..)
, hboxOnline
, hboxSurf
, hboxSurfIO
, hboxPoint
) where
import Data.ByteString.Lazy (toStrict)
import Data.ByteString.Builder (stringUtf8, toLazyByteString)
import Data.Monoid
import Data.Typeable
import System.IO.Unsafe
import System.Texrunner.Online hiding (hbox)
import qualified System.Texrunner.Online as Online
import System.Texrunner.Parse
import Diagrams.Core.Envelope (pointEnvelope)
import Diagrams.Prelude hiding (Box, (<>))
import Diagrams.Backend.PGF.Surface
data Hbox n = Hbox (Transformation V2 n) String
deriving Typeable
type instance V (Hbox n) = V2
type instance N (Hbox n) = n
instance Fractional n => Transformable (Hbox n) where
transform :: Transformation (V (Hbox n)) (N (Hbox n)) -> Hbox n -> Hbox n
transform Transformation (V (Hbox n)) (N (Hbox n))
t (Hbox Transformation V2 n
tt String
str) = forall n. Transformation V2 n -> String -> Hbox n
Hbox (Transformation (V (Hbox n)) (N (Hbox n))
t forall a. Semigroup a => a -> a -> a
<> Transformation V2 n
tt) String
str
instance Fractional n => Renderable (Hbox n) NullBackend where
render :: NullBackend
-> Hbox n -> Render NullBackend (V (Hbox n)) (N (Hbox n))
render NullBackend
_ Hbox n
_ = forall a. Monoid a => a
mempty
hboxPoint :: (OrderedField n, Typeable n, Renderable (Hbox n) b)
=> String -> QDiagram b V2 n Any
hboxPoint :: forall n b.
(OrderedField n, Typeable n, Renderable (Hbox n) b) =>
String -> QDiagram b V2 n Any
hboxPoint String
raw = forall b (v :: * -> *) n m.
Prim b v n
-> Envelope v n
-> Trace v n
-> SubMap b v n m
-> Query v n m
-> QDiagram b v n m
mkQD (forall p b.
(Transformable p, Typeable p, Renderable p b) =>
p -> Prim b (V p) (N p)
Prim (forall n. Transformation V2 n -> String -> Hbox n
Hbox forall a. Monoid a => a
mempty String
raw))
(forall n (v :: * -> *).
(Fractional n, Metric v) =>
Point v n -> Envelope v n
pointEnvelope forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin)
forall a. Monoid a => a
mempty
forall a. Monoid a => a
mempty
forall a. Monoid a => a
mempty
hboxSurf :: (TypeableFloat n, Renderable (Hbox n) b)
=> Surface -> String -> QDiagram b V2 n Any
hboxSurf :: forall n b.
(TypeableFloat n, Renderable (Hbox n) b) =>
Surface -> String -> QDiagram b V2 n Any
hboxSurf Surface
surf String
txt = forall a. IO a -> a
unsafePerformIO (forall n b.
(TypeableFloat n, Renderable (Hbox n) b) =>
Surface -> String -> IO (QDiagram b V2 n Any)
hboxSurfIO Surface
surf String
txt)
{-# NOINLINE hboxSurf #-}
hboxSurfIO :: (TypeableFloat n, Renderable (Hbox n) b)
=> Surface -> String -> IO (QDiagram b V2 n Any)
hboxSurfIO :: forall n b.
(TypeableFloat n, Renderable (Hbox n) b) =>
Surface -> String -> IO (QDiagram b V2 n Any)
hboxSurfIO Surface
surf String
txt = forall a. Surface -> OnlineTex a -> IO a
surfOnlineTexIO Surface
surf (forall n b.
(TypeableFloat n, Renderable (Hbox n) b) =>
String -> OnlineTex (QDiagram b V2 n Any)
hboxOnline String
txt)
hboxOnline :: (TypeableFloat n, Renderable (Hbox n) b)
=> String -> OnlineTex (QDiagram b V2 n Any)
hboxOnline :: forall n b.
(TypeableFloat n, Renderable (Hbox n) b) =>
String -> OnlineTex (QDiagram b V2 n Any)
hboxOnline String
txt = do
Box n
h n
d n
w <- forall n. Fractional n => ByteString -> OnlineTex (Box n)
Online.hbox (ByteString -> ByteString
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString forall a b. (a -> b) -> a -> b
$ String -> Builder
stringUtf8 String
txt)
let bb :: BoundingBox V2 n
bb = forall (v :: * -> *) n.
(Additive v, Foldable v, Ord n) =>
Point v n -> Point v n -> BoundingBox v n
fromCorners (forall (f :: * -> *) a. f a -> Point f a
P forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> V2 a
V2 n
0 (-n
d))
(forall (f :: * -> *) a. f a -> Point f a
P forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> V2 a
V2 n
w n
h)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b (v :: * -> *) n m.
Prim b v n
-> Envelope v n
-> Trace v n
-> SubMap b v n m
-> Query v n m
-> QDiagram b v n m
mkQD (forall p b.
(Transformable p, Typeable p, Renderable p b) =>
p -> Prim b (V p) (N p)
Prim (forall n. Transformation V2 n -> String -> Hbox n
Hbox forall a. Monoid a => a
mempty String
txt))
(forall a. Enveloped a => a -> Envelope (V a) (N a)
getEnvelope BoundingBox V2 n
bb)
(forall a. Traced a => a -> Trace (V a) (N a)
getTrace BoundingBox V2 n
bb)
forall a. Monoid a => a
mempty
(forall t m. HasQuery t m => t -> Query (V t) (N t) m
getQuery BoundingBox V2 n
bb)