1- {-# LANGUAGE FlexibleContexts #-}
2- {-# LANGUAGE NoMonomorphismRestriction #-}
3- {-# LANGUAGE TypeFamilies #-}
1+ {-# Language DerivingStrategies #-}
2+ {-# Language FlexibleContexts #-}
3+ {-# Language NoMonomorphismRestriction #-}
4+ {-# Language TypeFamilies #-}
5+ {-# Language TypeOperators #-}
46
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 )
1013
1114
1215main :: IO ()
@@ -35,7 +38,8 @@ arrowLine = with & shaftStyle %~ lw 3
3538
3639arrowBent :: (Typeable n , RealFloat n ) => ArrowOpts n
3740arrowBent =
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 ) ]
3943 in with & arrowShaft .~ shaft
4044 & headLength .~ 12
4145 & shaftStyle %~ lw 3
@@ -48,7 +52,7 @@ data AlignCell
4852 | Gapped
4953 | Spacing
5054 | Question
51- deriving (Eq , Show )
55+ deriving stock (Eq , Show )
5256
5357
5458toSymbol :: AlignCell -> Char
@@ -63,7 +67,9 @@ toSymbol Question = '?'
6367frames :: [Diagram B ]
6468frames = f <#$> ijks
6569 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+
6773 box = phantom (rect 28 11 :: Diagram B ) :: Diagram B
6874
6975
@@ -75,17 +81,27 @@ makeAlignments (i,j,k) = stackVertical
7581 , makeIndexPad ||| derivedAt i cAlign
7682 ]
7783 where
78- f = withEnvelope box
84+ f :: Monoid m => QDiagram b V2 Double m -> QDiagram b V2 Double m
85+ f = withEnvelope box
86+
7987 box = phantom (rect 1 2 :: Diagram B ) :: Diagram B
8088 makeIndexPad = box ||| box ||| box ||| box
8189 makeIndexLabel :: String -> Word -> Diagram B
8290 makeIndexLabel idx val = f smb ||| f eqs ||| f num ||| box
8391 where
8492 -- 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
8696 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
88101 txt = scale 1.5 . bold . text
102+ smb = txt idx
103+
104+ num = txt $ show val
89105
90106
91107stackVertical
@@ -116,11 +132,11 @@ alignmentAt i xs = foldlWithKey makeCell mempty cells
116132 where
117133 (h,t) = splitAt (fromEnum i) xs
118134 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
121137
122138 cursorStop :: Word
123- cursorStop = toEnum . length . dropWhile (== Spacing ) $ reverse cells
139+ cursorStop = toEnum . length . dropWhile (== Spacing ) $ reverse cells
124140
125141 makeCell :: Diagram B -> Int -> AlignCell -> Diagram B
126142 makeCell a k e
@@ -141,7 +157,7 @@ alignmentAt i xs = foldlWithKey makeCell mempty cells
141157
142158
143159cellText :: String -> Diagram B
144- cellText = alignT . scale (5 / 3 ) . (<> phantom box) . bold . text
160+ cellText = alignT . scale (5 / 3 ) . (<> phantom box) . bold . text
145161 where
146162 box = square 0.25 :: Diagram B
147163
@@ -177,8 +193,19 @@ grnLine = lineColor (sRGB 0 128 0)
177193stp :: Diagram B
178194stp = upper <> lower
179195 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
182209 mkLine = centerXY . lineWidth 2 . strokeLine . lineFromVertices
183210
184211
@@ -219,7 +246,9 @@ lPoints = p2 <$>
219246
220247labels :: [Diagram B ]
221248labels =
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
223252 in [ lab " Case 2"
224253 , lab " Case 3"
225254 , lab " Case 0"
0 commit comments