diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2010 Petr Rockai <me@mornfall.net>
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Petr Rockai nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/htune.cabal b/htune.cabal
new file mode 100644
--- /dev/null
+++ b/htune.cabal
@@ -0,0 +1,25 @@
+name:                htune
+version:             0.1
+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
+                     tuning information for multiple frequency peaks. Draws
+                     using gloss/opengl. Use mouse for panning & zooming.
+
+license:             BSD3
+license-file:        LICENSE
+
+-- The package author(s).
+author:              Petr Rockai
+maintainer:          me@mornfall.net
+category:            Sound
+build-type:          Simple
+
+-- extra-source-files:
+
+-- Constraint on the version of Cabal needed to build this package.
+cabal-version:       >=1.6
+
+Executable htune
+  main-is: main.hs
+  build-depends: base < 5, carray == 0.1.*, fft == 0.1.*, alsa-pcm == 0.6.*, gloss == 1.7.*
diff --git a/main.hs b/main.hs
new file mode 100644
--- /dev/null
+++ b/main.hs
@@ -0,0 +1,186 @@
+{-# LANGUAGE ScopedTypeVariables, ParallelListComp #-}
+import Graphics.Gloss
+import Graphics.Gloss.Interface.IO.Animate
+import Data.Complex
+import Data.IORef
+import Math.FFT
+import Data.Array.CArray
+import GHC.Float ( double2Float )
+import Foreign.ForeignPtr
+import Data.Char ( toUpper )
+import Data.List ( sortBy )
+
+import Sound.ALSA.PCM
+         ( SoundFmt(SoundFmt), sampleFreq, soundSourceRead,
+           SoundSource, alsaSoundSource, withSoundSource )
+import Foreign ( allocaArray, peekArray,
+                 Storable, Ptr, castPtr )
+import Data.Int ( Int16 )
+
+-- analyzer parameters
+fftSize, bufSize, rate :: Int
+fftSize = 16 * 1024
+winSize = 2 * fftSize
+bufSize = 2048
+rate = 44100
+fftDuration = fromIntegral winSize / fromIntegral rate -- seconds
+fftBin = fromIntegral rate / fromIntegral winSize -- hz
+fftLimits = (start, end)
+ where start :: Int = head $ dropWhile (cutoff $ fst $ head notecents) [1..]
+       end :: Int = head $ dropWhile (cutoff $ fst $ last notecents) [1..]
+       cutoff n = (<n) . cents . hz . fromIntegral
+
+-- frequency to tuning and back
+cents :: Double -> Double
+cents x = 100 * logBase (2**(1/12)) x
+uncent x = 2**(x/1200.0)
+shift :: (RealFrac a) => a -> Float
+shift x = (realToFrac x - realToFrac a55) / 2
+hz :: Double -> Double
+hz x = fftBin * x
+centscale :: Double -> Float
+centscale = shift . cents . hz
+a55, a3520 :: Double
+a55 = cents 55.25
+a3520 = cents 3520
+
+-- array twiddling
+mapArray f a = array (bounds a) $ map (\(i, v) -> (i, f i v)) $ assocs a
+
+shiftArray size old new = array (0, size' - 1) $ (zip [0..] $ drop remove $ elems old) ++ zip [retain..] (elems new)
+  where remove = dim old - retain
+        retain = minimum [ size - dim new, dim old ]
+        size' = retain + dim new
+        dim x = 1 + snd (bounds x) - fst (bounds x)
+
+quadEst :: Complex Double -> Complex Double -> Complex Double -> Double
+quadEst a x c = (y3 - y1) / ( 2 * ( 2 * y2 - y1 - y3 ) )
+  where y1 = magnitude a
+        y2 = magnitude x
+        y3 = magnitude c
+
+quinnEst :: Complex Double -> Complex Double -> Complex Double -> Double
+quinnEst a x c = 0.5 * (dp + dm) + tau (dp * dp) - tau (dm * dm)
+  where ap = (r c * r x + i c * i x) / (magnitude x ^ 2)
+        dp = (-ap) / (1 - ap)
+        am = (r a * r x + i a * i x) / (magnitude x ^ 2)
+        dm = am / (1 - am)
+        tau t = 0.25 * log (3 * t * t + 6 * t + 1) - sqrt 6 / 24 * log ((t + 1 - bit) / (t + 1 + bit))
+         where bit = sqrt (2/3)
+        i = imagPart
+        r = realPart
+
+peaks spd fft = map quinn $ sortBy (\x y -> compare (snd y) (snd x)) $ peaks' padded
+  where peaks' l
+           | (length $ take window l) < window = []
+           | maximum (map snd $ take window l) == snd (l !! center) = (l !! center) : (peaks' $ drop 1 l)
+           | otherwise = peaks' $ drop 1 l
+        padded = assocs spd
+        window = 15
+        center = 1 + window `div` 2
+        quinn (x, y) = (fromIntegral x + quinnEst (fft ! (x - 1)) (fft ! x) (fft ! (x + 1)), y) -- y is somewhat wrong
+
+maxPeak p [] = p
+maxPeak (mx, my) ((x, y):l)
+    | y > my = maxPeak (x, y) l
+    | otherwise = maxPeak (mx, my) l
+
+-- friendly names
+octave = [ "c", "cis", "d", "es", "e", "f", "fis", "g", "gis", "a", "b", "h" ]
+bass = let m (x:r) = toUpper x : r in map m octave
+decorate y = map (\x -> x ++ y)
+treble y = decorate y octave
+notenames = drop 9 $ decorate "," bass ++ bass ++ octave ++ treble "'" ++
+                     treble "''" ++ treble "'''" ++ treble "''''" ++ treble "'''''"
+notecents :: [(Double, String)]
+notecents = [ (x, y) | x <- [ a55, (a55+100) .. ] | y <- notenames ]
+showsign n = (if n >= 0 then "+" else "") ++ show n
+fancy :: Int -> ((Double, String), Int)
+fancy x = (notecents !! n, off)
+  where (n', off) | x' `mod` 100 > 50 = (x' `div` 100 + 1, x' `mod` 100 - 100)
+                  | otherwise = (x' `div` 100, x' `mod` 100)
+        n = maximum [0, n']
+        x' = x - round a55
+
+-- FFT twiddling
+hamming n i v = v * (0.53836 - 0.46164 * cos((2.0 * pi * fromIntegral i) / (fromIntegral n - 1)));
+spd x y = (1 / (fromIntegral fftSize ** 2)) * (x * x + y * y)
+spl x = case 100 * logBase 10 x of y | y < 100 -> 0
+                                     | otherwise -> y - 100
+normalize = id
+
+notebg ('a':_) = background 100
+notebg ('A':_) = background 100
+notebg _ = background 50
+
+-- UI bits
+draw = return . Translate (-640) (-280)
+background l = Color $ makeColor8 l l l 256
+
+guides = Pictures [ notebg y $ mark x y | (x, y) <- notecents ]
+  where mark x y = Pictures [ Line [ (shift x, 0), (shift x, 500) ]
+                            , Translate (shift x - 4) (-5) $ Rotate 90 $ Scale 0.25 0.25 $ Text y ]
+
+dbguides = background 100 $ Pictures $ concat markers
+  where markers = [ [ Line [ (0, y), (shift $ fst $ last notecents, y) ]
+                    , Translate (-30) y $ Scale 0.1 0.1 $ Text $ show (floor y) ]
+                  | y <- [50, 100 .. 450] ]
+
+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] ]
+  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)
+                             ]
+        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
+
+analyze bits = draw $ Pictures
+    [ guides
+    , dbguides
+    , Color white $ drawfft bufSPD
+    , drawpeaks bufSPD bufFFT
+    ]
+  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
+
+-- ALSA
+inputFormat :: SoundFmt Int16
+inputFormat = SoundFmt { sampleFreq = rate }
+
+main :: IO ()
+main = let source = alsaSoundSource "default" inputFormat
+        in allocaArray     bufSize $ \buf  ->
+           withSoundSource source  $ \from -> do
+               win <- newIORef $ array (0, 0) []
+               animateIO (InWindow "DFT" (1280,960) (0,0)) black (loop source from buf win)
+
+soundToArray src h buf size = do
+    n' <- soundSourceRead src h (castPtr buf) size
+    buf' <- newForeignPtr_ buf
+    unsafeForeignPtrToCArray buf' (0, n' - 1)
+
+loop :: SoundSource h Int16 -> h Int16 -> Ptr Int16 -> IORef (CArray Int Int16) -> Float -> IO Picture
+loop src h buf win time =
+    do new <- soundToArray src h buf bufSize
+       old <- readIORef win
+       let combined = shiftArray winSize old new
+       writeIORef win combined
+       case bounds combined of
+         (_, cwin) | cwin < winSize - 1 -> draw $ Pictures [ guides, dbguides ]
+                   | otherwise -> analyze combined
+