コードツール「フレット君」
コードを指定して、ウクレレのどのフレットを押えるか表示するツール「フレット君」を作ってみました。対応しているコードは、例えばCの場合、C、C7、Cm、Cm7、CM7、Cm7-5、Cdim、Caug、C9、Cadd9、Csus4、C7sus4です。
ダウンロード:
Windows用実行形式 + ソースコード
使い方:
コマンドプロンプトからfletkun.exeを実行します。コマンドライン引数にコードを指定します。こんな感じ。
C:\usr\home\s-tanaka\0000\haskell\fletkun>fletkun C
0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15
----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----
| | | C | | | | E | | | G | | | | | C
----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----
E | | | G | | | | | C | | | | E | | | G
----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----
C | | | | E | | | G | | | | | C | | |
----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----
G | | | | | C | | | | E | | | G | | |
C:\usr\home\s-tanaka\0000\haskell\fletkun>fletkun G7
0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15
----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----
| | B | | | D | | | F | | G | | | | B |
----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----
| F | | G | | | | B | | | D | | | F | | G
----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----
| | D | | | F | | G | | | | B | | | D |
----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----
G | | | | B | | | D | | | F | | G | | |
C:\usr\home\s-tanaka\0000\haskell\fletkun>fletkun Am7
0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15
----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----
A | | | C | | | | E | | | G | | A | | | C
----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----
E | | | G | | A | | | C | | | | E | | | G
----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----
C | | | | E | | | G | | A | | | C | | |
----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----
G | | A | | | C | | | | E | | | G | | A |ファイル: fletkun.hs
module Main (main) where
import System.Environment (getArgs, getProgName)
import Text.ParserCombinators.Parsec
import Text.Printf (printf)
data Note = C | C' | D | D' | E | F | F' | G | G' | A | A' | B
deriving (Eq, Ord, Enum)
instance Show Note where
show C = " C "
show C' = " C# "
show D = " D "
show D' = "D#Eb"
show E = " E "
show F = " F "
show F' = " F# "
show G = " G "
show G' = "G#Ab"
show A = " A "
show A' = "A#Bb"
show B = " B "
data Code =
Major Note | Minor Note | Seventh Note | Major7th Note | Minor7th Note |
Minor7thb5th Note | Dim Note | Aug Note | Ninth Note | Add9th Note |
SeventhSus4 Note | Sus4 Note
parseCode :: String -> Code
parseCode s =
case parse code "" s of
Right v -> v
Left e -> error $ show e
where
code :: Parser Code
code = do
c <- ext =<< note
eof
return c
note =
try (string "C#" >> return C') <|>
try (string "C" >> return C) <|>
try (string "D#" >> return D') <|>
try (string "D" >> return D) <|>
try (string "Eb" >> return D') <|>
try (string "E" >> return E) <|>
try (string "F#" >> return F') <|>
try (string "F" >> return F) <|>
try (string "G#" >> return G') <|>
try (string "G" >> return G) <|>
try (string "Ab" >> return G') <|>
try (string "A#" >> return A') <|>
try (string "A" >> return A) <|>
try (string "Bb" >> return A') <|>
try (string "B" >> return B)
ext n =
try (string "m7-5" >> return (Minor7thb5th n)) <|>
try (string "m7" >> return (Minor7th n)) <|>
try (string "m" >> return (Minor n)) <|>
try (string "7sus4" >> return (SeventhSus4 n)) <|>
try (string "7" >> return (Seventh n)) <|>
try (string "M7" >> return (Major7th n)) <|>
try (string "dim" >> return (Dim n)) <|>
try (string "aug" >> return (Aug n)) <|>
try (string "9" >> return (Ninth n)) <|>
try (string "add9" >> return (Add9th n)) <|>
try (string "sus4" >> return (Sus4 n)) <|>
try (string "" >> return (Major n))
notesFrom :: Note -> [Note]
notesFrom note = dropWhile (note /=) $ cycle [C .. B]
notesInCode :: Code -> [Note]
notesInCode code =
case code of
Major n -> notesInCode' n [0, 4, 7]
Minor n -> notesInCode' n [0, 3, 7]
Seventh n -> notesInCode' n [0, 4, 7, 10]
Major7th n -> notesInCode' n [0, 4, 7, 11]
Minor7th n -> notesInCode' n [0, 3, 7, 10]
Minor7thb5th n -> notesInCode' n [0, 3, 6, 10]
Dim n -> notesInCode' n [0, 3, 6, 9]
Aug n -> notesInCode' n [0, 3, 8]
Ninth n -> notesInCode' n [0, 4, 7, 10, 14]
Add9th n -> notesInCode' n [0, 4, 7, 14]
SeventhSus4 n -> notesInCode' n [0, 5, 7, 10]
Sus4 n -> notesInCode' n [0, 5, 7]
where
notesInCode' n is = map (notesFrom n !!) is
printFingerBoard :: Int -> [Note] -> IO ()
printFingerBoard numOfFlets ns =
head >> sep >>
str A >> sep >>
str E >> sep >>
str C >> sep >>
str G
where
join :: String -> [String] -> String
join _ [] = ""
join _ (x:[]) = x
join s (x:xs) = x ++ concatMap (s ++) xs
head = putStrLn $ join "|" $ map (printf " %2d ") [0 .. numOfFlets]
sep = putStrLn $ join "+" $ replicate (numOfFlets + 1) "----"
str n = putStrLn $ join "|" $ map str' $ take (numOfFlets + 1) $ notesFrom n
str' n
| elem n ns = show n
| otherwise = " "
main :: IO ()
main = do
prog <- getProgName
args <- getArgs
if null args
then putStrLn $ usage prog
else printFingerBoard 15 $ notesInCode $ parseCode $ args !! 0
where
usage p = "usage: " ++ p ++ " <code>"
-- Local Variables:
-- compile-command: "ghc -W -fno-warn-unused-matches --make -o fletkun fletkun"
-- End:BUGS:
表示される音が間違っていたらこっそり教えてください;-) 真面目にチェックできてません。あー、後、C6ぐらいは表示できるようにすべきでした。まぁ、またそのうち…
参照:
ぷよさんのコードフォーム検索ツール
