diff --git a/htune.cabal b/htune.cabal
--- a/htune.cabal
+++ b/htune.cabal
@@ -1,5 +1,5 @@
 name:                htune
-version:             0.1
+version:             0.2
 synopsis:            harmonic analyser and tuner for musical instruments
 description:         A real-time, graphical analyser of frequency spectrums.
                      Reads audio data from ALSA and draws a spectrogram with
diff --git a/main.hs b/main.hs
--- a/main.hs
+++ b/main.hs
@@ -7,8 +7,8 @@
 import Data.Array.CArray
 import GHC.Float ( double2Float )
 import Foreign.ForeignPtr
-import Data.Char ( toUpper )
-import Data.List ( sortBy )
+import Data.Char ( toUpper, toLower )
+import Data.List ( sortBy, findIndex )
 
 import Sound.ALSA.PCM
          ( SoundFmt(SoundFmt), sampleFreq, soundSourceRead,
@@ -128,35 +128,73 @@
 
 drawfft bits = Line $ [ (centscale $ fromIntegral x, double2Float $ y) | (x, y) <- assocs bits ]
 
-drawpeaks spd fft = Pictures $
-    [ draw (centscale x) (round . cents $ hz x) i
-    | (x, y) <- take 10 $ takeWhile ((> 150) . snd) $ peaks spd fft | i <- [10,9..1] ]
+centcolor c = case snd $ fancy c of
+    x | x <= -20 -> makeColor 1 0 1
+      | x <= -10 -> makeColor 0 1 1
+      | x > -10 && x < 10 -> makeColor 0 1 0
+      | x >= 10 -> makeColor 1 1 0
+      | x >= 20 -> makeColor 1 0 0
+
+drawpeaks peaks = Pictures $
+    [ draw (centscale x) (round . cents $ hz x) i | ((x, _), i) <- zip peaks [10,9..] ]
   where draw x c i = color c [ color' c (1 - fromIntegral (abs $ offset c) / 50) $
                                  [ Polygon [ (x, 0), (x, 500), (snap c, 500), (snap c, 0) ] ]
                              , color' c 0.9 $ [ Line [ (snap c, 0), (snap c, 500) ] ]
                              , Translate (maximum [snap c + 5, x + 5]) (200 + 25 * i) $
-                                  Scale 0.2 0.2 $ Text $ name c ++ showsign (offset c)
+                                  Scale 0.3 0.3 $ Text $ name c ++ showsign (offset c)
                              ]
         snap = shift . fst . fst . fancy
         name = snd . fst . fancy
         offset = snd . fancy
         color c = color' c 1
-        color' c t = case abs $ snd $ fancy c of
-                            x | x < 10 -> Color (makeColor 0 1 0 t) . Pictures
-                              | x < 20 -> Color (makeColor 1 1 0 t) . Pictures
-                              | otherwise -> Color (makeColor 1 0 0 t) . Pictures
+        color' c t = Color (centcolor c t) . Pictures
 
+drawpiano peaks = Pictures $ [ whitekey (c, unoctave n) white | (c, n) <- notecents, unoctave n `elem` whitekeys ] ++
+                             [ whitekey (snap p, name p) (color p) | p <- peaks', name p `elem` whitekeys ] ++
+                             [ blackkey (c, unoctave n) black | (c, n) <- notecents, unoctave n `elem` blackkeys ] ++
+                             [ blackkey (snap p, name p) (color p) | p <- peaks', name p `elem` blackkeys ]
+  where key c | snd c `elem` ["cis", "es", "fis", "gis", "b" ] = blackkey c
+              | otherwise = whitekey c
+        unoctave = map toLower . takeWhile (`notElem` ",'+")
+        color = uncurry centcolor
+        name = unoctave . snd . fst . fancy . fst
+        snap = fromIntegral . round . fst . fst . fancy . fst
+        peaks' = map (\(x, y) -> (round . cents $ hz x, double2Float y / 500)) peaks
+        poly c1 c2 p = Pictures [ Color c1 $ Polygon p, Color c2 $ Line p ]
+
+        octave = 600
+        width = octave / 7
+        whitekeys = ["a", "h", "c", "d", "e", "f", "g"]
+        blackkeys = ["b", "cis", "es", "fis", "gis", "b"]
+
+        keyat (top, bottom, w, fill, outline) c =
+            poly fill outline $ [(c - w, top), (c + w, top), (c + w, bottom), (c - w, bottom), (c - w, top)]
+
+        whitecenter (pos, x) = case findIndex (==x) whitekeys of
+            Just idx -> octave * fromIntegral ((round $ pos - a55) `div` 1200) + width * (fromIntegral idx)
+        whitekey (pos, x) c = keyat (-50, -350, width / 2, c, black) $ whitecenter (pos, x)
+
+        blackkey (pos, x) c = case x of
+            "b"   -> key ( 7) "a"
+            "cis" -> key (-7) "c"
+            "es"  -> key ( 7) "d"
+            "fis" -> key (-7) "f"
+            "gis" -> key ( 0) "g"
+          where key off rightof = keyat (-50, -250, width / 4, c, black) $ whitecenter (pos, rightof) + width / 2 + off
+
 analyze bits = draw $ Pictures
     [ guides
     , dbguides
     , Color white $ drawfft bufSPD
-    , drawpeaks bufSPD bufFFT
+    , drawpeaks peakl
+    , drawpiano peakl
     ]
   where bufFloat = mapArray (\i v -> hamming winSize i $ normalize $ fromIntegral v) bits
         bufFFT = array (start, end) $ drop start $ take end $ assocs $ dft bufFloat
         bufSPD :: CArray Int Double = liftArray (\(a :+ b) -> spl $ spd a b) $ bufFFT
         start = fst fftLimits
         end = snd fftLimits
+        peakl = take 10 $ takeWhile ((> 150) . snd) $ peaks bufSPD bufFFT
 
 -- ALSA
 inputFormat :: SoundFmt Int16