{-# 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) = 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

-- | 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 :: 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

-- | 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 :: 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 #-}

-- | 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 :: 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)

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