1
- {-# LANGUAGE FlexibleContexts #-}
2
- {-# LANGUAGE NoMonomorphismRestriction #-}
3
- {-# LANGUAGE TypeFamilies #-}
1
+ {-# Language DerivingStrategies #-}
2
+ {-# Language FlexibleContexts #-}
3
+ {-# Language NoMonomorphismRestriction #-}
4
+ {-# Language TypeFamilies #-}
5
+ {-# Language TypeOperators #-}
4
6
5
- import Data.Data
6
- import Data.Key
7
- import Diagrams.Backend.SVG.CmdLine
8
- import Diagrams.Prelude hiding (trace )
9
- import Prelude hiding (zip )
7
+ import Data.Data
8
+ import Data.Key
9
+ import Diagrams.Backend.SVG.CmdLine
10
+ import Diagrams.Prelude hiding (trace )
11
+ import Diagrams.TwoD.Text (Text )
12
+ import Prelude hiding (zip )
10
13
11
14
12
15
main :: IO ()
@@ -35,7 +38,8 @@ arrowLine = with & shaftStyle %~ lw 3
35
38
36
39
arrowBent :: (Typeable n , RealFloat n ) => ArrowOpts n
37
40
arrowBent =
38
- let shaft = trailFromVertices $ p2 <$> [ (0 , 0 ), (0 , 1.5 ), (9 , 1.5 ), (9 , 3 ) ]
41
+ let shaft :: (Floating n , Ord n ) => Trail V2 n
42
+ shaft = trailFromVertices $ p2 <$> [ (0 , 0 ), (0 , 1.5 ), (9 , 1.5 ), (9 , 3 ) ]
39
43
in with & arrowShaft .~ shaft
40
44
& headLength .~ 12
41
45
& shaftStyle %~ lw 3
@@ -48,7 +52,7 @@ data AlignCell
48
52
| Gapped
49
53
| Spacing
50
54
| Question
51
- deriving (Eq , Show )
55
+ deriving stock (Eq , Show )
52
56
53
57
54
58
toSymbol :: AlignCell -> Char
@@ -63,7 +67,9 @@ toSymbol Question = '?'
63
67
frames :: [Diagram B ]
64
68
frames = f <#$> ijks
65
69
where
66
- f k = (# named (" frame " <> show k)) . pad 1.4 . (<> box) . centerXY . makeAlignments
70
+ f :: Int -> (Word , Word , Word ) -> QDiagram B V2 Double Any
71
+ f k = (# named (" frame " <> show k)) . pad 1.4 . (<> box) . centerXY . makeAlignments
72
+
67
73
box = phantom (rect 28 11 :: Diagram B ) :: Diagram B
68
74
69
75
@@ -75,17 +81,27 @@ makeAlignments (i,j,k) = stackVertical
75
81
, makeIndexPad ||| derivedAt i cAlign
76
82
]
77
83
where
78
- f = withEnvelope box
84
+ f :: Monoid m => QDiagram b V2 Double m -> QDiagram b V2 Double m
85
+ f = withEnvelope box
86
+
79
87
box = phantom (rect 1 2 :: Diagram B ) :: Diagram B
80
88
makeIndexPad = box ||| box ||| box ||| box
81
89
makeIndexLabel :: String -> Word -> Diagram B
82
90
makeIndexLabel idx val = f smb ||| f eqs ||| f num ||| box
83
91
where
84
92
-- We make a different cell for each symbol to ensure "monospacing."
85
- smb = txt idx
93
+ eqs
94
+ :: (Typeable n , RealFloat n , Renderable (Text n ) b )
95
+ => QDiagram b V2 n Any
86
96
eqs = txt " ="
87
- num = txt $ show val
97
+
98
+ txt
99
+ :: (Typeable n , RealFloat n , Renderable (Text n ) b )
100
+ => String -> QDiagram b V2 n Any
88
101
txt = scale 1.5 . bold . text
102
+ smb = txt idx
103
+
104
+ num = txt $ show val
89
105
90
106
91
107
stackVertical
@@ -116,11 +132,11 @@ alignmentAt i xs = foldlWithKey makeCell mempty cells
116
132
where
117
133
(h,t) = splitAt (fromEnum i) xs
118
134
cells
119
- | all (== Spacing ) t = h <> [Spacing ]
120
- | otherwise = h <> filter (/= Spacing ) t
135
+ | all (== Spacing ) t = h <> [Spacing ]
136
+ | otherwise = h <> filter (/= Spacing ) t
121
137
122
138
cursorStop :: Word
123
- cursorStop = toEnum . length . dropWhile (== Spacing ) $ reverse cells
139
+ cursorStop = toEnum . length . dropWhile (== Spacing ) $ reverse cells
124
140
125
141
makeCell :: Diagram B -> Int -> AlignCell -> Diagram B
126
142
makeCell a k e
@@ -141,7 +157,7 @@ alignmentAt i xs = foldlWithKey makeCell mempty cells
141
157
142
158
143
159
cellText :: String -> Diagram B
144
- cellText = alignT . scale (5 / 3 ) . (<> phantom box) . bold . text
160
+ cellText = alignT . scale (5 / 3 ) . (<> phantom box) . bold . text
145
161
where
146
162
box = square 0.25 :: Diagram B
147
163
@@ -177,8 +193,19 @@ grnLine = lineColor (sRGB 0 128 0)
177
193
stp :: Diagram B
178
194
stp = upper <> lower
179
195
where
180
- upper = mkLine [origin, sqrt 2 ^& sqrt 2 ]
181
- lower = mkLine [0 ^& sqrt 2 , sqrt 2 ^& 0 ]
196
+ upper
197
+ :: (Typeable n , RealFloat n , Renderable (Path V2 n ) b )
198
+ => QDiagram b V2 n Any
199
+ upper = mkLine [origin, sqrt 2 ^& sqrt 2 ]
200
+
201
+ lower
202
+ :: (Typeable n , RealFloat n , Renderable (Path V2 n ) b )
203
+ => QDiagram b V2 n Any
204
+ lower = mkLine [0 ^& sqrt 2 , sqrt 2 ^& 0 ]
205
+
206
+ mkLine
207
+ :: (Typeable n , RealFloat n , Renderable (Path V2 n ) b )
208
+ => [Point V2 n ] -> QDiagram b V2 n Any
182
209
mkLine = centerXY . lineWidth 2 . strokeLine . lineFromVertices
183
210
184
211
@@ -219,7 +246,9 @@ lPoints = p2 <$>
219
246
220
247
labels :: [Diagram B ]
221
248
labels =
222
- let lab = centerXY . scale 1.8 . pad 1.5 . bold . text
249
+ let lab :: (Typeable n , RealFloat n , Renderable (Text n ) b )
250
+ => String -> QDiagram b V2 n Any
251
+ lab = centerXY . scale 1.8 . pad 1.5 . bold . text
223
252
in [ lab " Case 2"
224
253
, lab " Case 3"
225
254
, lab " Case 0"
0 commit comments