{-# 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) = Transformation V2 n -> String -> Hbox n
forall n. Transformation V2 n -> String -> Hbox n
Hbox (Transformation (V (Hbox n)) (N (Hbox n))
Transformation V2 n
t Transformation V2 n -> Transformation V2 n -> Transformation V2 n
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
_ = Render NullBackend (V (Hbox n)) (N (Hbox n))
forall a. Monoid a => a
mempty
hboxPoint :: (OrderedField n, Typeable n, Renderable (Hbox n) b)
=> String -> QDiagram b V2 n Any
hboxPoint :: String -> QDiagram b V2 n Any
hboxPoint String
raw = Prim b V2 n
-> Envelope V2 n
-> Trace V2 n
-> SubMap b V2 n Any
-> Query V2 n Any
-> QDiagram b V2 n Any
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 (Hbox n -> Prim b (V (Hbox n)) (N (Hbox n))
forall p b.
(Transformable p, Typeable p, Renderable p b) =>
p -> Prim b (V p) (N p)
Prim (Transformation V2 n -> String -> Hbox n
forall n. Transformation V2 n -> String -> Hbox n
Hbox Transformation V2 n
forall a. Monoid a => a
mempty String
raw))
(Point V2 n -> Envelope V2 n
forall n (v :: * -> *).
(Fractional n, Metric v) =>
Point v n -> Envelope v n
pointEnvelope Point V2 n
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin)
Trace V2 n
forall a. Monoid a => a
mempty
SubMap b V2 n Any
forall a. Monoid a => a
mempty
Query V2 n Any
forall a. Monoid a => a
mempty
hboxSurf :: (TypeableFloat n, Renderable (Hbox n) b)
=> Surface -> String -> QDiagram b V2 n Any
hboxSurf :: Surface -> String -> QDiagram b V2 n Any
hboxSurf Surface
surf String
txt = IO (QDiagram b V2 n Any) -> QDiagram b V2 n Any
forall a. IO a -> a
unsafePerformIO (Surface -> String -> IO (QDiagram b V2 n Any)
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 :: Surface -> String -> IO (QDiagram b V2 n Any)
hboxSurfIO Surface
surf String
txt = Surface
-> OnlineTex (QDiagram b V2 n Any) -> IO (QDiagram b V2 n Any)
forall a. Surface -> OnlineTex a -> IO a
surfOnlineTexIO Surface
surf (String -> OnlineTex (QDiagram b V2 n Any)
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 :: String -> OnlineTex (QDiagram b V2 n Any)
hboxOnline String
txt = do
Box n
h n
d n
w <- ByteString -> OnlineTex (Box n)
forall n. Fractional n => ByteString -> OnlineTex (Box n)
Online.hbox (ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Builder
stringUtf8 String
txt)
let bb :: BoundingBox V2 n
bb = Point V2 n -> Point V2 n -> BoundingBox V2 n
forall (v :: * -> *) n.
(Additive v, Foldable v, Ord n) =>
Point v n -> Point v n -> BoundingBox v n
fromCorners (V2 n -> Point V2 n
forall (f :: * -> *) a. f a -> Point f a
P (V2 n -> Point V2 n) -> V2 n -> Point V2 n
forall a b. (a -> b) -> a -> b
$ n -> n -> V2 n
forall a. a -> a -> V2 a
V2 n
0 (-n
d))
(V2 n -> Point V2 n
forall (f :: * -> *) a. f a -> Point f a
P (V2 n -> Point V2 n) -> V2 n -> Point V2 n
forall a b. (a -> b) -> a -> b
$ n -> n -> V2 n
forall a. a -> a -> V2 a
V2 n
w n
h)
QDiagram b V2 n Any -> OnlineTex (QDiagram b V2 n Any)
forall (m :: * -> *) a. Monad m => a -> m a
return (QDiagram b V2 n Any -> OnlineTex (QDiagram b V2 n Any))
-> QDiagram b V2 n Any -> OnlineTex (QDiagram b V2 n Any)
forall a b. (a -> b) -> a -> b
$ Prim b V2 n
-> Envelope V2 n
-> Trace V2 n
-> SubMap b V2 n Any
-> Query V2 n Any
-> QDiagram b V2 n Any
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 (Hbox n -> Prim b (V (Hbox n)) (N (Hbox n))
forall p b.
(Transformable p, Typeable p, Renderable p b) =>
p -> Prim b (V p) (N p)
Prim (Transformation V2 n -> String -> Hbox n
forall n. Transformation V2 n -> String -> Hbox n
Hbox Transformation V2 n
forall a. Monoid a => a
mempty String
txt))
(BoundingBox V2 n
-> Envelope (V (BoundingBox V2 n)) (N (BoundingBox V2 n))
forall a. Enveloped a => a -> Envelope (V a) (N a)
getEnvelope BoundingBox V2 n
bb)
(BoundingBox V2 n
-> Trace (V (BoundingBox V2 n)) (N (BoundingBox V2 n))
forall a. Traced a => a -> Trace (V a) (N a)
getTrace BoundingBox V2 n
bb)
SubMap b V2 n Any
forall a. Monoid a => a
mempty
(BoundingBox V2 n
-> Query (V (BoundingBox V2 n)) (N (BoundingBox V2 n)) Any
forall t m. HasQuery t m => t -> Query (V t) (N t) m
getQuery BoundingBox V2 n
bb)