diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2023, Henning Thielemann
+
+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 Henning Thielemann 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/Makefile b/Makefile
new file mode 100644
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,35 @@
+.SECONDARY:     %.frames
+
+RATE = 50
+#RATE = 25
+#RATE = 10
+
+RESOLUTION = -g1920x1080 -r540
+#RESOLUTION = -g1280x720 -r360
+#RESOLUTION = -g960x540 -r270
+
+%.pdf:	%.mid
+	cabal run boomwhacker -- --rate $(RATE) $< $@
+
+%.wav:	%.mid
+	timidity -A300 -Ow $<
+
+# Resolution is one Postscript point (1/72 inch).
+%.frames:	%.pdf
+	mkdir -p /tmp/$*-frames
+	rm -f /tmp/$*-frames/*
+	gs -sDEVICE=png16m -sOutputFile=/tmp/$*-frames/%04d.png \
+	  -dNOPAUSE -dBATCH -dTextAlphaBits=2 -dGraphicsAlphaBits=2 \
+	  $(RESOLUTION) $<
+	touch $@
+
+%.flv:	%.frames %.wav
+	ffmpeg -r $(RATE) -f image2 -i /tmp/$*-frames/%04d.png -i $*.wav \
+	  -vcodec flashsv -acodec copy -y $@
+
+Roboter.flv:	Roboter.frames Roboter.aac
+	ffmpeg -r $(RATE) -f image2 -i /tmp/Roboter-frames/%04d.png -i Roboter.aac \
+	  -vcodec flashsv -acodec copy -y $@
+
+README.html:	README.md
+	pandoc --standalone $< --output $@
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,3 @@
+#! /usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain
diff --git a/boomwhacker.cabal b/boomwhacker.cabal
new file mode 100644
--- /dev/null
+++ b/boomwhacker.cabal
@@ -0,0 +1,50 @@
+Name:                boomwhacker
+Version:             0.0
+Synopsis:            Convert MIDI file to play-along boomwhacker animation
+Description:
+  Convert MIDI file to play-along boomwhacker animation:
+  .
+  Run it like so:
+  .
+  > boomwhacker song.mid song.pdf
+  .
+  @song.mid@ is the input file that must be a MIDI file.
+  @song.pdf@ is the output file, a PDF file.
+  You can convert the PDF to a series of PNG files using @ghostscript@
+  and this one to a video using @ffmpeg@.
+  See @Makefile@ for example command calls.
+Homepage:            https://hub.darcs.net/thielema/boomwhacker
+License:             BSD3
+License-File:        LICENSE
+Author:              Henning Thielemann
+Maintainer:          haskell@henning-thielemann.de
+Category:            Music, Sound
+Build-Type:          Simple
+Cabal-Version:       >=1.10
+Extra-Source-Files:
+  Makefile
+
+Source-Repository this
+  Tag:         0.0
+  Type:        darcs
+  Location:    https://hub.darcs.net/thielema/boomwhacker
+
+Source-Repository head
+  Type:        darcs
+  Location:    https://hub.darcs.net/thielema/boomwhacker
+
+Executable boomwhacker
+  Build-Depends:
+    HPDF >=1.6 && <1.7,
+    optparse-applicative >=0.11 && <0.19,
+    midi >=0.2.2 && <0.3,
+    event-list >=0.1.1 && <0.2,
+    filepath >=1.3 && <1.5,
+    containers >=0.4 && <0.7,
+    array >=0.4 && <0.6,
+    utility-ht >=0.0.10 && <0.1,
+    base >=4.5 && <5
+  Hs-Source-Dirs:      src
+  Main-Is:             Main.hs
+  Default-Language:    Haskell2010
+  GHC-Options:         -Wall -fwarn-incomplete-uni-patterns -fwarn-tabs
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,269 @@
+module Main where
+
+import qualified Options.Applicative as OP
+
+import qualified Graphics.PDF as PDF
+
+import qualified Sound.MIDI.Message.Class.Query as Query
+import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
+import qualified Sound.MIDI.File.Load as MidiLoad
+import qualified Sound.MIDI.File.Event as MidiEvent
+import qualified Sound.MIDI.File as MidiFile
+
+import qualified Data.EventList.Absolute.TimeBody as AbsEventList
+import qualified Data.EventList.Relative.TimeBody as EventList
+
+import qualified Data.Array as Array
+import qualified Data.IntMap as IntMap
+import qualified Data.Map as Map
+import qualified Data.Foldable as Fold
+import Data.IntMap (IntMap)
+import Data.Map (Map)
+import Data.Array (Array, listArray, (!))
+import Data.Tuple.HT (mapTriple, thd3)
+import Data.String (fromString)
+import Data.Complex (Complex((:+)))
+
+import Control.Monad (join)
+import Control.Applicative ((<$>), (<*>))
+
+
+
+{- |
+Terminated tubes sorted with respect to upper boundary
+and unterminated tubes sorted with respect to note.
+-}
+type VisibleTubes = (Map Double [(Double, Int)], IntMap Double)
+
+{- |
+This also handles three kinds of corruption:
+NoteOff without NoteOn, NoteOn without NoteOff,
+duplicate NoteOn (which is kind of special case of NoteOn without NoteOff)
+-}
+welcomeNextEvent ::
+   (Double, (Int, Bool)) -> VisibleTubes -> VisibleTubes
+welcomeNextEvent (timeStamp, (pitch, noteOn)) (terminated, unterminated) =
+   (case IntMap.lookup pitch unterminated of
+      Nothing -> terminated
+      Just timeStart ->
+         Map.insertWith (++) timeStamp [(timeStart, pitch)] terminated
+    ,
+    if noteOn
+      then IntMap.insert pitch timeStamp unterminated
+      else IntMap.delete pitch unterminated)
+
+farewellEvents :: Double -> VisibleTubes -> VisibleTubes
+farewellEvents time (terminated, unterminated) =
+   (thd3 $ Map.splitLookup time terminated, unterminated)
+
+layoutTubes ::
+   (Query.C ev) =>
+   Double -> VoiceMsg.Pitch ->
+   AbsEventList.T Double ev -> [(Double, (Int, Bool))]
+layoutTubes timeStep zeroKey =
+   AbsEventList.toPairList .
+   AbsEventList.mapMaybe
+      (\ev -> do
+         (_c, (_v, p, noteOn)) <- Query.noteExplicitOff ev
+         return (VoiceMsg.subtractPitch zeroKey p, noteOn)) .
+   AbsEventList.mapTime (/timeStep)
+
+windowInitialize ::
+   Double -> [(Double, (Int, Bool))] ->
+   (VisibleTubes, [(Double, (Int, Bool))])
+windowInitialize time events =
+   case span ((<=time) . fst) events of
+      (displayed, remaining) ->
+         (foldl (flip welcomeNextEvent) (Map.empty, IntMap.empty) displayed,
+          remaining)
+
+windowMove ::
+   (Double, Double) ->
+   (VisibleTubes, [(Double, (Int, Bool))]) ->
+   (VisibleTubes, [(Double, (Int, Bool))])
+windowMove (newFrom, newTo) (currentDisplay, events) =
+   case span ((<=newTo) . fst) events of
+      (newDisplayed, remaining) ->
+         (foldl (flip welcomeNextEvent)
+            (farewellEvents newFrom currentDisplay)
+            newDisplayed,
+          remaining)
+
+windowLayout :: VisibleTubes -> [(Double, Maybe Double, Int)]
+windowLayout (terminated, unterminated) =
+   Fold.fold
+      (Map.mapWithKey
+         (\to -> map (\(from, pitch) -> (from, Just to, pitch)))
+         terminated)
+   ++
+   map
+      (\(pitch, from) -> (from, Nothing, pitch))
+      (IntMap.toList unterminated)
+
+
+mergeTracksToAbsolute :: MidiFile.T -> AbsEventList.T Double MidiEvent.T
+mergeTracksToAbsolute (MidiFile.Cons typ division tracks) =
+   AbsEventList.mapTime realToFrac $
+   EventList.toAbsoluteEventList 0 $
+   MidiFile.mergeTracks typ $
+   map (MidiFile.secondsFromTicks division) tracks
+
+
+noteNames :: [Char]
+noteNames =
+   ['C', '#', 'D', '#', 'E', 'F', '#', 'G', '#', 'A', '#', 'H', 'C']
+
+noteColors :: Array Int PDF.Color
+noteColors =
+   let xs =
+         (,,)  90   0   0 :
+         (,,)  90  15   0 :
+         (,,)  95  35   0 :
+         (,,)  95  60   5 :
+         (,,)  95 100  10 :
+         (,,)  25 100  25 :
+         (,,)   5  70  20 :
+         (,,)   5  45  20 :
+         (,,)   0  20  65 :
+         (,,)  35   0  70 :
+         (,,)  55   0  55 :
+         (,,)  75  35  75 :
+         (,,)  90   0   0 :
+         []
+   in listArray (0, length xs - 1) $
+      map (\(r,g,b) -> PDF.Rgb (0.01*r) (0.01*g) (0.01*b)) xs
+
+grey :: Double -> PDF.Color
+grey brightness = PDF.Rgb brightness brightness brightness
+
+colorFromPitch :: Int -> PDF.Color
+colorFromPitch pitch =
+   if Array.inRange (Array.bounds noteColors) pitch
+      then noteColors ! pitch
+      else grey 0.5
+
+
+writePDF ::
+   FilePath -> PDF.FontName -> Int -> [[(Double, Maybe Double, Int)]] -> IO ()
+writePDF path fontName fontHeight_ blocks = do
+   let fontHeight = fromIntegral fontHeight_
+       width  = 16 * fontHeight
+       height =  9 * fontHeight
+       bottom = 0.5 * fontHeight
+       left = 20
+       gradientHeight = 9
+       boxLeftFromPitch pitch = left + fromIntegral pitch * fontHeight
+       rect = PDF.PDFRect 0 0 width height
+   let (bowHeight, tube) =
+         if True
+            then
+               (0.2,
+                \l b r t -> do
+                  let b1 = b - bowHeight*fontHeight
+                  let t1 = t - bowHeight*fontHeight
+                  PDF.beginPath (l:+b)
+                  PDF.curveto (l:+b1) (r:+b1) (r:+b)
+                  PDF.lineto (r:+t)
+                  PDF.curveto (r:+t1) (l:+t1) (l:+t)
+               )
+            else (0, \l b r t -> PDF.addShape $ PDF.Rectangle (l:+b) (r:+t))
+   stdFont <- either (fail . show) return =<< PDF.mkStdFont fontName
+   PDF.runPdf path PDF.standardDocInfo rect $
+      Fold.for_ blocks $ \block -> do
+         page <- PDF.addPage Nothing
+         PDF.drawWithPage page $ do
+            PDF.fillColor PDF.black
+            PDF.fill $ PDF.Rectangle (0:+0) (width:+height)
+            Fold.for_ block $ \(from,mTo,pitch) -> do
+               let boxLeft = boxLeftFromPitch pitch
+               let to = maybe height ((fontHeight*) . subtract 0.1) mTo
+               PDF.paintWithShading
+                     (PDF.AxialShading
+                        boxLeft (bottom+fontHeight*(from-bowHeight))
+                        boxLeft (bottom+fontHeight*(from+gradientHeight))
+                        (colorFromPitch pitch) PDF.black) $
+                  tube
+                     (boxLeft+fontHeight*0.1) (bottom+fontHeight*from)
+                     (boxLeft+fontHeight*0.9) (bottom+to)
+            Fold.for_ (zip [0..] noteNames) $ \(pitch,char) -> do
+               PDF.fillColor $ colorFromPitch pitch
+               let boxLeft = boxLeftFromPitch pitch
+               let bowHalf = bowHeight/2
+               tube
+                  (boxLeft+fontHeight*0.1) (bottom+fontHeight*(bowHalf-0.1))
+                  (boxLeft+fontHeight*0.9) (bottom+fontHeight*(bowHalf+0.9))
+               PDF.fillPath
+               PDF.fillColor PDF.white
+               PDF.setWidth 0.5
+               PDF.strokeColor (grey 0.1)
+               PDF.drawText $ do
+                  let font = PDF.PDFFont stdFont fontHeight_
+                  PDF.setFont font
+                  let label = fromString [char]
+                  let leftOffset = (fontHeight - PDF.textWidth font label) / 2
+                  PDF.textStart (boxLeft + leftOffset) bottom
+                  PDF.renderMode PDF.FillAndStrokeText
+                  PDF.displayText label
+
+
+animate :: Double -> Integer -> VoiceMsg.Pitch -> FilePath -> FilePath -> IO ()
+animate timeStep frameRate zeroKey input output = do
+   midi <- MidiLoad.fromFile input
+   let track = mergeTracksToAbsolute midi
+   let duration = maybe 0 (fst.snd) $ AbsEventList.viewR track
+   let bottom = 0.5
+   let height = 9
+   let start = windowInitialize height $ layoutTubes timeStep zeroKey track
+   let ts = map (/timeStep) [0, recip (fromInteger frameRate) .. duration]
+   let frames =
+         scanl (\display times -> windowMove times display) start $
+         map (\t -> (t-bottom, t+height)) ts
+   writePDF output PDF.Helvetica_Bold 16 $
+      zipWith
+         (\t ->
+            map (mapTriple (subtract t, fmap (subtract t), id)) .
+            windowLayout . fst)
+         ts
+         frames
+
+
+info :: OP.Parser a -> OP.ParserInfo a
+info p =
+   OP.info
+      (OP.helper <*> p)
+      (OP.fullDesc <>
+       OP.progDesc "Generate boomwhacker animation from MIDI file.")
+
+parser :: OP.Parser (IO ())
+parser =
+   pure animate
+   <*>
+      OP.option OP.auto
+         (OP.long "timestep" <>
+          OP.metavar "SECONDS" <>
+          OP.value 0.2 <>
+          OP.help "time step between lines")
+   <*>
+      OP.option OP.auto
+         (OP.long "rate" <>
+          OP.metavar "FPS" <>
+          OP.value 25 <>
+          OP.help "frame rate")
+   <*>
+      (VoiceMsg.toPitch <$>
+         OP.option OP.auto
+            (OP.long "zerokey" <>
+             OP.metavar "INT" <>
+             OP.value 60 <>
+             OP.help "MIDI key for the left-most tube"))
+   <*>
+      OP.strArgument
+         (OP.metavar "INPUT" <>
+          OP.help "Input MIDI file")
+   <*>
+      OP.strArgument
+         (OP.metavar "OUTPUT" <>
+          OP.help "Output PDF file")
+
+main :: IO ()
+main = join $ OP.execParser $ info parser