1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
module Pretty
( Doc (..),
Pretty,
pretty,
diagram,
module Pretty.Color,
color,
colorDull,
)
where
import Pretty.Color
data Doc
= Col [Doc]
| Lit (Maybe (Intensity, Color)) String
deriving (Show, Eq)
class Pretty a where
pretty :: a -> Doc
instance Pretty Char where
pretty = pretty . (: [])
instance Pretty String where
pretty = Lit Nothing
diagram :: Int -> [Float] -> Doc
diagram w xs = Col (map chart (discretize xs'))
where
xs' = replicate (2 * w - length xs) 0 ++ reverse (take (2 * w) xs)
chart :: (Int, Int) -> Doc
chart n = colorize n (pretty (chart' n))
chart' (0, 0) = '⠀'
chart' (0, 1) = '⢀'
chart' (0, 2) = '⢠'
chart' (0, 3) = '⢰'
chart' (0, 4) = '⢸'
chart' (1, 0) = '⡀'
chart' (1, 1) = '⣀'
chart' (1, 2) = '⣠'
chart' (1, 3) = '⣰'
chart' (1, 4) = '⣸'
chart' (2, 0) = '⡄'
chart' (2, 1) = '⣄'
chart' (2, 2) = '⣤'
chart' (2, 3) = '⣴'
chart' (2, 4) = '⣼'
chart' (3, 0) = '⡆'
chart' (3, 1) = '⣆'
chart' (3, 2) = '⣦'
chart' (3, 3) = '⣶'
chart' (3, 4) = '⣾'
chart' (4, 0) = '⡇'
chart' (4, 1) = '⣇'
chart' (4, 2) = '⣧'
chart' (4, 3) = '⣷'
chart' (4, 4) = '⣿'
chart' _ = error "chart': argument >4 (or <0)"
colorize (n, m) = colorize' (max n m)
colorize' 0 = colorDull Green
colorize' 1 = color Green
colorize' 2 = colorDull Yellow
colorize' 3 = color Yellow
colorize' 4 = color Red
colorize' _ = error "colorize': argument >4 (or <0)"
discretize :: [Float] -> [(Int, Int)]
discretize [] = []
discretize (_ : []) = []
discretize (x1 : x2 : xs) =
(round (x1 * 4), round (x2 * 4)) : discretize xs
color :: Color -> Doc -> Doc
color c = color' (Vivid, c)
colorDull :: Color -> Doc -> Doc
colorDull c = color' (Dull, c)
color' :: (Intensity, Color) -> Doc -> Doc
color' c (Lit _ s) = Lit (Just c) s
color' c (Col ds) = Col (map (color' c) ds)
|
