-
Notifications
You must be signed in to change notification settings - Fork 0
/
Century.hs
executable file
·136 lines (110 loc) · 3.99 KB
/
Century.hs
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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
module Century (century) where
import System.Environment(getArgs)
import Data.List (intersperse, transpose, intercalate)
import Data.Char (isAlpha)
import Prelude hiding (putStrLn)
yr2cent :: Int -> Int
yr2cent year = ((year-1) `div` 100) + 1
whereinCent :: Year -> Where
whereinCent (BCyear year)
| ((year-1) `mod` 100) < 10 = Last
| ((year-1) `mod` 100) < 40 = Latter
| ((year-1) `mod` 100) > 60 = First
| otherwise = Half
whereinCent (ACyear year)
| ((year-1) `mod` 100) > 90 = Last
| ((year-1) `mod` 100) < 40 = First
| ((year-1) `mod` 100) > 60 = Latter
| otherwise = Half
year2cent :: Year -> Century
year2cent y@(BCyear n) = BCcent (yr2cent n) (whereinCent y)
year2cent y@(ACyear n) = ACcent (yr2cent n) (whereinCent y)
data Year = BCyear Int | ACyear Int
data Century = BCcent Int Where | ACcent Int Where
instance Show Year where
show (BCyear n) = "B" ++ show n ++ "年"
show (ACyear n) = "A" ++ show n ++ "年"
instance Show Century where
show (BCcent cent w) = "B" ++ show cent ++ "C" ++ show w
show (ACcent cent w) = "A" ++ show cent ++ "C" ++ show w
data Where = First | Half | Latter | Last
instance Show Where where
show First = "前半"
show Half = "中頃"
show Latter = "後半"
show Last = "末"
parseYear :: String -> Year
parseYear year = case year of
str@('B':_) -> BCyear $ read $ dropWhile isAlpha str
str@(x:_) -> ACyear $ read $ dropWhile isAlpha str
interc' :: Char -> String -> String
interc' c str = intercalate [c] (map return str)
showGraphicalYear :: Int -> String
showGraphicalYear y = intercalate "\n" $ (interc' '□' $ show y) : ((take 3 resultDeluted) ++ ["----"] ++ (drop 3 $ take 6 resultDeluted) ++ ["----"] ++ (drop 6 resultDeluted))
where
ns :: [Int]
ns = map ((read::String->Int) . (\x -> [x])) $ show y
fs :: [Char -> String]
fs = map replicate ns
rs :: [String]
rs = map ($ '■') fs
water :: [String] -> String
water strs = map (const '□') $ mostLong strs
dilute :: [String] -> [String]
dilute strs = map (flip overwrite $ water strs) strs
overwrite :: [a] -> [a] -> [a]
overwrite [] [] = []
overwrite [] bs = bs
overwrite (a:as) (b:bs) = a:(overwrite as bs)
whiteAndBlank :: [String]
whiteAndBlank = dilute rs
mostLong :: [String] -> String
mostLong (s1:(s2:[])) | length s1 <= length s2 = s2
| length s1 > length s2 = s1
mostLong (s1:(s2:ss)) | length s1 <= length s2 = mostLong $ s2:ss
| length s1 > length s2 = mostLong $ s1:ss
result :: [String]
result = map (interc' '□') $ reverse $ transpose whiteAndBlank
resultDeluted :: [String]
resultDeluted = reverse $ overwrite (reverse result) (replicate 9 ['□'])
toMelody :: Year -> [String]
toMelody (BCyear n) = map toTone $ show n
toMelody (ACyear n) = map toTone $ show n
toEmozy :: Year -> [String]
toEmozy (BCyear n) = map toEmoji $ show n
toEmozy (ACyear n) = map toEmoji $ show n
toTone :: Char -> String
toTone '0' = "ドb"
toTone '1' = "ド"
toTone '2' = "レ"
toTone '3' = "ミ"
toTone '4' = "ファ"
toTone '5' = "ソ"
toTone '6' = "ラ"
toTone '7' = "シ"
toTone '8' = "^ド"
toTone '9' = "^レ"
toEmoji :: Char -> String
toEmoji '0' = "🍹"
toEmoji '1' = "🍓"
toEmoji '2' = "\129365"
toEmoji '3' = "👡"
toEmoji '4' = "⛵"
toEmoji '5' = "🍚"
toEmoji '6' = "🚀"
toEmoji '7' = "🐦"
toEmoji '8' = "🐙"
toEmoji '9' = "🐳"
year :: (Monad m) => (String -> m ()) -> String -> m ()
year putStrLn y = do
putStrLn $ (show $ parseYear y) ++ "(" ++ (show $ year2cent $ parseYear y) ++ ")"
putStrLn "-----\n"
putStrLn $ showGraphicalYear $ read $ dropWhile isAlpha y
putStrLn "-----"
putStrLn $ intercalate " " $ toMelody $ parseYear y
putStrLn $ intercalate " " $ toEmozy $ parseYear y
century :: (Monad m) => (m [String]) -> (String -> m ()) -> m ()
century getArgs putStrLn = do
years <- getArgs
--let ys = map parseYear years
mapM_ (year putStrLn) years