module Data.Clock.IntervalTree.Format where

import Data.Clock.IntervalTree

-- | pretty print a stamp, mathematical notation like in the original paper.
fmtStamp :: Stamp -> String
fmtStamp :: Stamp -> String
fmtStamp (Stamp ITCId
i ITCEvent
e) = String
"(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ITCId -> String
fmtId ITCId
i String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ITCEvent -> String
fmtEv ITCEvent
e String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
  where
    fmtId :: ITCId -> String
fmtId ITCId
ITCIdOff = String
"0"
    fmtId ITCId
ITCIdOn = String
"1"
    fmtId (ITCIdBranch ITCId
l ITCId
r) = String
"(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ITCId -> String
fmtId ITCId
l String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ITCId -> String
fmtId ITCId
r String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"

    fmtEv :: ITCEvent -> String
fmtEv (ITCEventLeaf Integer
n) = Integer -> String
forall a. Show a => a -> String
show Integer
n
    fmtEv (ITCEventBranch Integer
n ITCEvent
l ITCEvent
r) = String
"(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ITCEvent -> String
fmtEv ITCEvent
l String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ITCEvent -> String
fmtEv ITCEvent
r String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"

{- | prints a stamp as a tikz picture for latex usage.
   This mostly aided me in visual debugging.
-}
fmtStampTikz :: Stamp -> String
fmtStampTikz :: Stamp -> String
fmtStampTikz (Stamp ITCId
i ITCEvent
e) = ITCId -> String
fmtIdsTikz ITCId
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ITCEvent -> String
fmtEventsTikz ITCEvent
e
  where
    tikzWidth, tikzLineHeight :: Double
    tikzWidth :: Double
tikzWidth = Double
5
    tikzLineHeight :: Double
tikzLineHeight = Double
0.25

    tikzRect :: Maybe String -> (Double, Double) -> (Double, Double) -> String
    tikzRect :: Maybe String -> (Double, Double) -> (Double, Double) -> String
tikzRect Maybe String
_ (Double, Double)
_ (Double
w, Double
h)
        | Double
w Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 = String
""
        | Double
h Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 = String
""
    tikzRect Maybe String
m (Double
x, Double
y) (Double
w, Double
h) =
        String
"\\node[rectangle,draw=black,anchor=north west,"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (case Maybe String
m of Just String
s -> String
"fill=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
","; Maybe String
Nothing -> String
"")
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"minimum width="
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show Double
w
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"cm"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
",minimum height="
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show Double
h
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"cm] at ("
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show Double
x
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"cm,"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show Double
y
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"cm) {};\n"

    fmtIdsTikz :: ITCId -> String
    fmtIdsTikz :: ITCId -> String
fmtIdsTikz ITCId
i0 = Double -> Double -> ITCId -> String
go Double
0 Double
tikzWidth ITCId
i0
      where
        go :: Double -> Double -> ITCId -> String
go Double
oh Double
w ITCId
ITCIdOn = Maybe String -> (Double, Double) -> (Double, Double) -> String
tikzRect (String -> Maybe String
forall a. a -> Maybe a
Just String
"blue!40!white") (Double
oh, - Double
tikzLineHeight) (Double
w, Double
tikzLineHeight)
        go Double
oh Double
w (ITCIdBranch ITCId
l ITCId
r) = Double -> Double -> ITCId -> String
go Double
oh (Double
w Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) ITCId
l String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> ITCId -> String
go (Double
oh Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
w Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) (Double
w Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) ITCId
r
        go Double
_ Double
_ ITCId
_ = String
""

    fmtEventsTikz :: ITCEvent -> String
    fmtEventsTikz :: ITCEvent -> String
fmtEventsTikz ITCEvent
e0 = Double -> Double -> Double -> ITCEvent -> String
go Double
tikzWidth Double
0 (- Double
tikzLineHeight) ITCEvent
e0
      where
        go :: Double -> Double -> Double -> ITCEvent -> String
go Double
w Double
oh Double
ov (ITCEventLeaf Integer
n) = Maybe String -> (Double, Double) -> (Double, Double) -> String
tikzRect Maybe String
forall a. Maybe a
Nothing (Double
oh, Double
ov Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
tikzLineHeight)) (Double
w, Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
tikzLineHeight)
        go Double
w Double
oh Double
ov (ITCEventBranch Integer
n ITCEvent
l ITCEvent
r) =
            Double -> Double -> Double -> ITCEvent -> String
go Double
w Double
oh Double
ov (Integer -> ITCEvent
ITCEventLeaf Integer
n)
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Double -> ITCEvent -> String
go (Double
w Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) Double
oh (Double
ov Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
tikzLineHeight)) ITCEvent
l
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Double -> ITCEvent -> String
go (Double
w Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) (Double
oh Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
w Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) (Double
ov Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
tikzLineHeight)) ITCEvent
r