{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Backend.PGF
-- Copyright   :  (c) 2014 Christopher Chalmers
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- A hbox a primitive Tex box, typically used for holding text and
-- formulas but can hold anything. This module provides functions for
-- retrieving the dimensions of these boxes to give diagrams the correct
-- envelopes.
-----------------------------------------------------------------------------
module Diagrams.Backend.PGF.Hbox
  ( Hbox (..)

    -- * Enveloped diagrams
    -- | The dimensions of a hbox can be recovered by calling Tex. The
    --   resulting envelope has its origin at the baseline of the text.
    --
    --   <<diagrams/hbox.svg#width=200 hbox>>
  , hboxOnline

   -- ** Non-Online version
   -- | These versions bypass 'OnlineTex' by just running a whole tex
   --   program just to get the size of a single hbox. This is not
   --   recommended but because it is slow, but can be convenient if
   --   you only need one or two hbox sizes.
  , hboxSurf
  , hboxSurfIO

    -- * Point envelope diagrams
  , 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

-- | Primitive for placing raw Tex commands in a hbox.
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

-- | Raw Tex commands in a hbox with no envelope. Transformations are
-- applied normally. This primitive ignores
-- 'Diagrams.TwoD.Text.FontSize'.
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

-- | Hbox with bounding box envelope. Note that each box requires a call to
--   Tex. For multiple boxes consider using 'hboxOnline' to get multiple boxes
--   from a single call. (uses unsafePerformIO)
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 #-}

-- | Hbox with bounding box envelope. Note that each box requires a call to
--   Tex. For multiple boxes consider using 'hboxOnline' to get multiple boxes
--   from a single call.
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)

-- | Hbox with bounding box envelope.
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)