module Data.Clock.IntervalTree.Format where
import Data.Clock.IntervalTree
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
")"
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