diff --git a/CHANGES b/CHANGES
--- a/CHANGES
+++ b/CHANGES
@@ -1,4 +1,25 @@
 
+
+0.6.0 to 0.7.0:
+
+  * Changed @ChannelPrefix@ constructor to have a single 
+    argument - channel number (previously it stored a constant 
+    tag 0x01 as well as channel number).
+
+  * Added @SysExCont@ and @SysExEscape@ constructors to the 
+    @MidiSysExEvent@ data type.
+
+  * Added new pretty printers - @Csv@ based on @midicsv@ and 
+    @Ascii@ based on the ASCII MIDI representation in the book 
+    Beyond Midi (the zmidi ASCII representation is simplified).
+    The demo application @MidiPrint@ now allows choice of pretty
+    printer.
+
+  * @printMidiHeader@ and @printMidiTrack@ from @Pretty@ changed
+    to MidiFiles as arguments, @printMidi@ has now become 
+    @putMidi@.
+
+
 0.5.0 to 0.6.0:
   
   * Extended the parser and changed the syntax tree to interpret 
diff --git a/demo/MidiCopy.hs b/demo/MidiCopy.hs
--- a/demo/MidiCopy.hs
+++ b/demo/MidiCopy.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS -Wall #-}
 
--- Read a MIDI file, output the syntax tree.
+-- Read a MIDI file, build a syntax tree and encode it again.
 -- Are the files the same?
 
 
@@ -19,8 +19,11 @@
     _      -> mapM_ putStrLn $ 
               [ "Usage: MidiCopy <filename>"
               , "--"
-              , "Read the file, building a syntax tree, print the syntax tree."
+              , "Read the file, building a syntax tree, generate binary output"
+              , "from the syntax tree."
+              , ""
               , "Tests that read and write are isomorphic." 
+              , ""
               ]
 
 
@@ -29,7 +32,11 @@
     ans <- readMidi filename
     case ans of
       Left err -> print err
-      Right a  -> do { mapM_ putStrLn $ printMidiHeader $ mf_header a
-                     ; writeMidi (filename ++ ".001") a }
+      Right mfile -> let outfile = filename ++ ".001"
+                     in do { mapM_ putStrLn $ printMidiHeader mfile
+                           ; putStrLn ""
+                           ; writeMidi outfile mfile
+                           ; putStrLn $ "Wrote file: " ++ outfile
+                           }
 
  
diff --git a/demo/MidiPrint.hs b/demo/MidiPrint.hs
--- a/demo/MidiPrint.hs
+++ b/demo/MidiPrint.hs
@@ -5,26 +5,75 @@
 -- Note - GHC (Windows at least) appears to throw an error if
 -- the copyright symbol is used a Text meta-event.
 
+
+
 module Main where
 
 import ZMidi.Core
 
+import System.Console.GetOpt
 import System.Environment
+import System.Exit
 
 
+
+header :: String 
+header = unlines $ 
+    [ "Usage: MidiPrint --format=... <filename>"
+    , ""
+    , "Formats are 'csv', 'ascii', 'original'."
+    ]
+
+help_message :: String
+help_message = unlines $  
+    [ "Decode binary MIDI files." ]
+
+
+data Flag = Usage
+          | OutFormat String
+  deriving (Eq, Show)
+
+
+options :: [OptDescr Flag]
+options =
+    [ Option ['h'] ["help"]     (NoArg Usage)        help_message
+    , Option ['f'] ["format"]   (ReqArg OutFormat "original")  "output format"
+    ]
+
 main :: IO ()
 main = do 
   args <- getArgs
-  case args of
-    [path] -> process path
-    _ ->  putStrLn "Usage: MidiPrint <filename>"
+  let (opts, nonopts, errs) = getOpt Permute options args
+  main2 opts nonopts errs
 
-process :: FilePath -> IO ()
-process filename = do
+
+main2 :: [Flag] -> [FilePath] -> [String] -> IO ()
+main2 opts            _        _ 
+  | Usage       `elem` opts         = midiPrintExit $ usageInfo header options
+main2 [OutFormat ss]  [infile] []   = process ss infile
+main2 []              [infile] []   = process "original" infile
+main2 _               _        errs = 
+    midiPrintExitFail 1 (concat errs ++ usageInfo header options)
+
+
+midiPrintExit :: String -> IO ()
+midiPrintExit s = putStrLn s >> exitWith ExitSuccess
+
+midiPrintExitFail :: Int -> String -> IO ()
+midiPrintExitFail i s = putStrLn s >> exitWith (ExitFailure i)
+
+
+process :: String -> FilePath -> IO ()
+process fmt filename = do
     ans <- readMidi filename
     case ans of
-      Left (ParseErr n msg) -> 
-                putStrLn $ "Parse failure at " ++ show n ++ ": " ++ msg
-      Right m               -> printMidi m
+      Left (ParseErr n msg) ->
+          midiPrintExitFail 1 $ "Parse failure at " ++ show n ++ ": " ++ msg
+      Right m               -> outputMidi fmt m
 
  
+outputMidi :: String -> (MidiFile -> IO ())
+outputMidi "csv"        = putCsv
+outputMidi "ascii"      = putAscii
+outputMidi "original"   = putMidi
+outputMidi _            = const $ putStrLn "Unrecognized output format."
diff --git a/demo/MidiTune.hs b/demo/MidiTune.hs
--- a/demo/MidiTune.hs
+++ b/demo/MidiTune.hs
@@ -19,6 +19,7 @@
 main = do 
     createDirectoryIfMissing True "./out/"
     writeMidi "./out/midi_tune.mid" midi_tune01
+    putStrLn "Wrote file: ./out/midi_tune.mid"
     
 
 midi_tune01 :: MidiFile
@@ -36,16 +37,15 @@
 
     sound_track = MidiTrack [ (0, MetaEvent $ TextEvent SEQUENCE_NAME "Track 1")
                             , (0, MetaEvent $ SetTempo 500000)
-                            , (0,   VoiceEvent $ NoteOn  0 60 127)
-                            , (480, VoiceEvent $ NoteOff 0 60 15)
-                            , (0,   VoiceEvent $ NoteOn  0 62 127)
-                            , (480, VoiceEvent $ NoteOff 0 62 15)
-                            , (0,   VoiceEvent $ NoteOn  0 64 127)
-                            , (480, VoiceEvent $ NoteOff 0 64 15)
-                            , (0,   VoiceEvent $ NoteOn  0 66 127)
-                            , (480, VoiceEvent $ NoteOff 0 66 15)
+                            , (0,   VoiceEvent RS_OFF $ NoteOn  0 60 127)
+                            , (480, VoiceEvent RS_OFF $ NoteOff 0 60 15)
+                            , (0,   VoiceEvent RS_OFF $ NoteOn  0 62 127)
+                            , (480, VoiceEvent RS_OFF $ NoteOff 0 62 15)
+                            , (0,   VoiceEvent RS_OFF $ NoteOn  0 64 127)
+                            , (480, VoiceEvent RS_OFF $ NoteOff 0 64 15)
+                            , (0,   VoiceEvent RS_OFF $ NoteOn  0 66 127)
+                            , (480, VoiceEvent RS_OFF $ NoteOff 0 66 15)
                             , (0, MetaEvent $ EndOfTrack) 
                             ]
-                  
 
- 
+
diff --git a/src/ZMidi/Core.hs b/src/ZMidi/Core.hs
--- a/src/ZMidi/Core.hs
+++ b/src/ZMidi/Core.hs
@@ -3,7 +3,7 @@
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  ZMidi.Core
--- Copyright   :  (c) Stephen Tetley 2010-2012
+-- Copyright   :  (c) Stephen Tetley 2010-2013
 -- License     :  BSD3
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
@@ -21,19 +21,23 @@
 
 module ZMidi.Core
   (
+
     module ZMidi.Core.Canonical
   , module ZMidi.Core.Datatypes
   , module ZMidi.Core.Pretty
+  , module ZMidi.Core.Pretty.Ascii
+  , module ZMidi.Core.Pretty.Csv
   , module ZMidi.Core.ReadFile
   , module ZMidi.Core.VersionNumber
   , module ZMidi.Core.WriteFile
-  
-    
+      
   ) where
 
 import ZMidi.Core.Canonical
 import ZMidi.Core.Datatypes
 import ZMidi.Core.Pretty
+import ZMidi.Core.Pretty.Ascii
+import ZMidi.Core.Pretty.Csv
 import ZMidi.Core.ReadFile
 import ZMidi.Core.VersionNumber
 import ZMidi.Core.WriteFile
diff --git a/src/ZMidi/Core/Canonical.hs b/src/ZMidi/Core/Canonical.hs
--- a/src/ZMidi/Core/Canonical.hs
+++ b/src/ZMidi/Core/Canonical.hs
@@ -1,10 +1,9 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# OPTIONS -Wall #-}
 
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  ZMidi.Core.Canonical
--- Copyright   :  (c) Stephen Tetley 2012
+-- Copyright   :  (c) Stephen Tetley 2012-2013
 -- License     :  BSD3
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
@@ -21,13 +20,13 @@
 module ZMidi.Core.Canonical
   (
 
-
-    canonical    
+    canonical
 
   ) where
 
 import ZMidi.Core.Datatypes
 
+
 -- | Convert an MidiFile into \"canonical\" form where any 
 -- abbreviation introduced by Running Status is expanded.
 --
@@ -52,4 +51,8 @@
 transVoiceEvent :: MidiRunningStatus -> MidiVoiceEvent -> MidiVoiceEvent
 transVoiceEvent RS_ON (NoteOn ch pch 0) = NoteOff ch pch 0
 transVoiceEvent _     evt               = evt
+
+
+
+
 
diff --git a/src/ZMidi/Core/Datatypes.hs b/src/ZMidi/Core/Datatypes.hs
--- a/src/ZMidi/Core/Datatypes.hs
+++ b/src/ZMidi/Core/Datatypes.hs
@@ -4,7 +4,7 @@
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  ZMidi.Core.Datatypes
--- Copyright   :  (c) Stephen Tetley 2010-2012
+-- Copyright   :  (c) Stephen Tetley 2010-2013
 -- License     :  BSD3
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
@@ -41,6 +41,7 @@
   , MidiDataOther(..)
   , MidiVoiceEvent(..)
   , MidiSysExEvent(..)
+  , MidiSysExContPacket(..)
   , MidiSysCommonEvent(..)
   , MidiSysRealTimeEvent(..)
   , MidiMetaEvent(..)
@@ -59,8 +60,8 @@
 -- from the previous event rather than an absolute time. 
 --
 -- DeltaTime is a newtype wrapper over Word32, note that in MIDI 
--- files it is represented as a @varlen@ to save space rather than 
--- a four byte number. 
+-- files it is represented as a @varlen@ to potentially save 
+-- space that would otherwise require a four byte number. 
 --
 newtype DeltaTime = DeltaTime { getDeltaTime :: Word32 }
   deriving (Enum,Eq,Ord,Num,Integral,Real)
@@ -68,6 +69,8 @@
 instance Show DeltaTime where
   showsPrec p = showsPrec p . getDeltaTime
 
+
+
 -- | TagByte is an alias to 'Word8'.
 --
 type TagByte = Word8
@@ -213,7 +216,7 @@
     | MetaEvent         MidiMetaEvent
 
 
-  deriving (Eq,Show,Ord)
+  deriving (Eq,Ord,Show)
 
 
 -- | Data events are events with tags from 0x00 to 0x7F. 
@@ -304,21 +307,43 @@
     | PitchBend           Word8 Word16
 
 
-  deriving (Eq,Show,Ord)
+  deriving (Eq,Ord,Show)
 
 -- | \SysEx\ - system exclusive event. 
 --
 data MidiSysExEvent
-    -- | SysEx event.
+    
+    -- | Single SysEx event.
     -- 
     -- > F0 * length * data
     -- 
     -- An uninterpreted sys-ex event.
     --
-    = SysEx               Word32 [Word8]
-  deriving (Eq,Show,Ord)
+    = SysExSingle Word32 [Word8]
 
+    -- | SysEx sent as (non-standard) multiple continuation 
+    -- packets.
+    --
+    -- > F0 * length * packet1 ... [SysExContPacket]
+    --
+    | SysExCont Word32 [Word8] [MidiSysExContPacket]
 
+    -- | Escape sequence of one-or-more SysEx events.
+    --
+    -- > F7 * length * data
+    --
+    | SysExEscape Word32 [Word8]
+  deriving (Eq,Ord,Show)
+
+-- | Continuation packet for a (non-standard) multi-part SysEx 
+-- event.
+--
+-- Apprently this format is use by Casio. 
+--
+data MidiSysExContPacket = MidiSysExContPacket DeltaTime Word32 [Word8]
+  deriving (Eq,Ord,Show)
+
+
 -- | System common event.
 --
 -- Common information for all channels in a system. 
@@ -380,7 +405,7 @@
     -- > F7
     -- 
     | EOX
-  deriving (Eq,Show,Ord)
+  deriving (Eq,Ord,Show)
 
 
 -- | System real-time event.
@@ -446,7 +471,7 @@
     -- > FF
     --
     | SystemReset
-  deriving (Eq,Show,Ord)
+  deriving (Eq,Ord,Show)
 
 
 
@@ -468,7 +493,7 @@
     -- Free text field (e.g. copyright statement). The contents 
     -- can notionally be any length.
     --
-    = TextEvent           MidiTextType String
+    = TextEvent MidiTextType String
 
     -- | Sequence Number 
     -- 
@@ -483,7 +508,7 @@
     -- The sequence number event should occur at the start of a 
     -- track, before any non-zero time events.
     --
-    | SequenceNumber      Word16
+    | SequenceNumber Word16
 
     -- | Channel prefix 
     -- 
@@ -491,9 +516,7 @@
     -- 
     -- Relay all meta and sys-ex events to the given channel.
     --
-    -- The first byte should always be 1.
-    -- 
-    | ChannelPrefix       Word8 Word8
+    | ChannelPrefix Word8
 
     -- | Midi port
     -- 
@@ -513,7 +536,7 @@
     --
     -- > FF 51 03 * microseconds_per_quarter_note
     --
-    | SetTempo            Word32
+    | SetTempo Word32
 
     -- | SMPTE offest
     -- 
@@ -523,13 +546,13 @@
     -- should occur at the start of a track, before any non-zero 
     -- time events.
     --
-    | SMPTEOffset         Word8 Word8 Word8 Word8 Word8
+    | SMPTEOffset Word8 Word8 Word8 Word8 Word8
     
     -- | Time signature 
     -- 
     -- > FF 58 04 * numerator * denominator * metro * num_32nd_notes
     --
-    | TimeSignature       Word8 Word8 Word8 Word8
+    | TimeSignature Word8 Word8 Word8 Word8
     
     -- | Key signature 
     --
@@ -540,7 +563,7 @@
     --
     -- @scale_type@ indicates major or minor.  
     --
-    | KeySignature        Int8 MidiScaleType
+    | KeySignature Int8 MidiScaleType
     
     -- | SSME 
     -- 
@@ -548,15 +571,16 @@
     -- 
     -- Sequencer specific meta-event - uninterpreted.
     --
-    | SSME                Word32 [Word8]
+    | SSME Word32 [Word8]
 
     -- | Unrecognized Meta Event
     --
     -- > FF * type * length * data 
     --
-    | MetaOther           Word8 Word32 [Word8]
+    | MetaOther Word8 Word32 [Word8]
 
-  deriving (Eq,Show,Ord)
+  deriving (Eq,Ord,Show)
+
 
 -- | Scale type - @major@ or @minor@ or @SCALE_OTHER@.  
 --
diff --git a/src/ZMidi/Core/Internal/ExtraTypes.hs b/src/ZMidi/Core/Internal/ExtraTypes.hs
--- a/src/ZMidi/Core/Internal/ExtraTypes.hs
+++ b/src/ZMidi/Core/Internal/ExtraTypes.hs
@@ -3,7 +3,7 @@
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  ZMidi.Core.Internal.ExtraTypes
--- Copyright   :  (c) Stephen Tetley 2010
+-- Copyright   :  (c) Stephen Tetley 2010-2013
 -- License     :  BSD3
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
diff --git a/src/ZMidi/Core/Internal/ParserMonad.hs b/src/ZMidi/Core/Internal/ParserMonad.hs
--- a/src/ZMidi/Core/Internal/ParserMonad.hs
+++ b/src/ZMidi/Core/Internal/ParserMonad.hs
@@ -3,7 +3,7 @@
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  ZMidi.Core.Internal.ParseMonad
--- Copyright   :  (c) Stephen Tetley 2010-2012
+-- Copyright   :  (c) Stephen Tetley 2010-2013
 -- License     :  BSD3
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
@@ -29,6 +29,7 @@
   , setRunningEvent
 
   , peek
+  , cond
   , dropW8
   , word8
   , int8
@@ -38,6 +39,7 @@
   , word32be
   , char8
 
+
   , (<??>)
   , fatalError
 
@@ -45,7 +47,7 @@
   , gencount
   , text
   , boundRepeat
-
+  , pair
   
 
   ) where
@@ -155,6 +157,16 @@
     Nothing      -> (Left (ParseErr n "peek - no more data."), s)
     Just (a,_)   -> (Right a, ParserState n rs bs)
 
+-- | Conditionally get a Word8. Fails if input is finished.
+-- Consumes data on if predicate succeeds, does not consume if
+-- predicate fails.
+--
+cond :: (Word8 -> Bool) -> ParserM (Maybe Word8)
+cond pf = ParserM $ \s@(ParserState n rs bs) -> case L.uncons bs of 
+    Nothing      -> (Left (ParseErr n "peek - no more data."), s)
+    Just (a,bs1) -> if pf a then (Right $ Just a, ParserState (n+1) rs bs1)
+                            else (Right Nothing, ParserState n rs bs)
+                       
 
 -- | Drop a Word8.
 --
@@ -278,21 +290,30 @@
                   }
 
 
+-- | Run a parser twice, pairing the result.
+--
+pair :: ParserM a -> ParserM (a,a)
+pair p = (,) <$> p <*> p
 
 --------------------------------------------------------------------------------
 -- helpers
 
-
+-- | Take two elements from the ByteString.
+--
 uncons2 :: L.ByteString -> Maybe (Word8,Word8,L.ByteString)
 uncons2 bs = L.uncons bs  >>= \(a,bs1) -> 
              L.uncons bs1 >>= \(b,bs2) -> return (a,b,bs2)
 
 
+-- | Take three elements from the ByteString.
+--
 uncons3 :: L.ByteString -> Maybe (Word8,Word8,Word8,L.ByteString)
 uncons3 bs = L.uncons bs  >>= \(a,bs1) -> 
              L.uncons bs1 >>= \(b,bs2) -> 
              L.uncons bs2 >>= \(c,bs3) -> return (a,b,c,bs3)
 
+-- | Take four elements from the ByteString.
+--
 uncons4 :: L.ByteString -> Maybe (Word8,Word8,Word8,Word8,L.ByteString)
 uncons4 bs = L.uncons bs  >>= \(a,bs1)  -> 
              L.uncons bs1 >>= \(b,bs2) -> 
@@ -300,15 +321,20 @@
              L.uncons bs3 >>= \(d,bs4) -> return (a,b,c,d,bs4)
 
 
+-- | Build a Word16 (big endian).
+--
 w16be :: Word8 -> Word8 -> Word16
 w16be a b       = (shiftL `flip` 8  $ fromIntegral a) + fromIntegral b
 
+-- | Build a Word24 (big endian).
+--
 w24be :: Word8 -> Word8 -> Word8 -> Word32
 w24be a b c     = (shiftL `flip` 16  $ fromIntegral a) 
                 + (shiftL `flip`  8  $ fromIntegral b) 
                 + fromIntegral c
 
-
+-- | Build a Word16 (big endian).
+--
 w32be :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
 w32be a b c d   = (shiftL `flip` 24  $ fromIntegral a) 
                 + (shiftL `flip` 16  $ fromIntegral b) 
diff --git a/src/ZMidi/Core/Internal/SimpleFormat.hs b/src/ZMidi/Core/Internal/SimpleFormat.hs
--- a/src/ZMidi/Core/Internal/SimpleFormat.hs
+++ b/src/ZMidi/Core/Internal/SimpleFormat.hs
@@ -3,7 +3,7 @@
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  ZMidi.Core.Internal.SimpleFormat
--- Copyright   :  (c) Stephen Tetley 2010-2012
+-- Copyright   :  (c) Stephen Tetley 2010-2013
 -- License     :  BSD3
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
@@ -17,11 +17,27 @@
 module ZMidi.Core.Internal.SimpleFormat
   (
 
-    Doc
+    ColumnSpecs(..) 
+  , ColumnSpec(..)
+  , Table
+  , runTable
+  , execTable
+  , tellFree
+  , tellRow
+  , tellBlank
+  , tellBreak
+  , localColumns
+  , nextTrack
+  , arbTrack
+  , incrDelta
+
+  , WString
+ 
+
   , width
-  , output
+  , outputDoc
 
-  , cat
+  , (<+>)
   , sep
   , char
   , text
@@ -31,10 +47,14 @@
   , padr
   , hex2  
   , hex4
+  , int
   , integral
 
   ) where
 
+
+
+import Control.Applicative
 import Data.Monoid
 import Data.Word
 import Numeric
@@ -47,20 +67,201 @@
 
 
 type HString = H Char
+type HLines  = H String
 
+
 -- | Make a HString of spaces.
 --
 spaceH :: Int -> HString 
 spaceH n = showString $ replicate n ' '
 
-
+-- | Materialize a Hughes list.
+--
 fromH :: H a -> [a]
 fromH = ($ [])
 
+-- | Empty Hughes list.
+--
+emptyH :: H a 
+emptyH = id
+
+
+-- | Snoc an element to the right end.
+--
+snocH :: H a -> a -> H a
+snocH f a = f . (a:)
+
+
+
+--------------------------------------------------------------------------------
+
+-- | Column formats for table printing.
+--
+data ColumnSpecs = ColumnSpecs { col_sep :: Char, col_fmts :: [ColumnSpec] }
+  deriving (Eq,Show)  
+
+-- | Print a column with left or right padding.
+-- 
+data ColumnSpec = PadL Int | PadR Int
+  deriving (Eq,Ord,Show)
+
+-- | Internal state.
+--
+data St = St { get_tracknum :: !Int, get_acctime :: Integer }
+
+-- | Initial state.
+--
+state_zero :: St
+state_zero = St { get_tracknum = 0 
+                , get_acctime  = 0
+                }
+  
+-- | Monad for generating output as a table.
+--
+newtype Table a = Table { 
+    getTable :: ColumnSpecs -> St -> HLines -> (St,HLines,a) }
+
+
+instance Functor Table where
+  fmap f ma = Table $ \r s ac -> 
+                 let (s1,ac1,a) = getTable ma r s ac in (s1, ac1, f a)
+
+
+instance Applicative Table where
+  pure a    = Table $ \_ s ac -> (s,ac,a)
+  mf <*> ma = Table $ \r s ac -> 
+                let (s1,ac1,f) = getTable mf r s ac
+                    (s2,ac2,a) = getTable ma r s1 ac1
+                in (s2,ac2,f a)
+
+
+
+instance Monad Table where
+  return    = pure
+  ma >>= k  = Table $ \r s ac -> 
+                let (s1,ac1,a) = getTable ma r s ac in getTable (k a) r s1 ac1
+
+
+-- | Run the Table monad, returning both output and answer.
+--
+runTable :: ColumnSpecs -> Table a -> ([String],a)
+runTable hdrs ma = 
+    let (_,hf,a) = getTable ma hdrs state_zero emptyH in (fromH hf,a)
+
+
+-- | Exec the Table monad, returning just the output.
+--
+execTable :: ColumnSpecs -> Table a -> [String]
+execTable hdrs = fst . runTable hdrs
+
+
+
+
+-- | Tell a row with free formatting.
+--
+-- Row is actually a function : track_num * running_time -> WString
+-- 
+tellFree :: (Int -> Integer -> WString) -> Table ()
+tellFree wf = Table $ \_ s ac -> 
+    let next = fromH $ doch $ wf (get_tracknum s) (get_acctime s)
+    in (s, ac `snocH` next, ())
+
+
+-- | Tell a row with column formatting.
+--
+-- Row is actually a function : track_num * running_time -> [WString]
+-- 
+tellRow :: (Int -> Integer -> [WString]) -> Table ()
+tellRow wsf = Table $ \r s ac -> 
+    let next = formatRow r $ wsf (get_tracknum s) (get_acctime s)
+    in (s, ac `snocH` next, ())
+
+-- | Tell a blank line.
+--
+tellBlank :: Table ()
+tellBlank = Table $ \_ s ac -> let next = ""
+                               in (s, ac `snocH` next, ())
+
+-- | Tell a breaking line (formatted as a dashed line). 
+--
+tellBreak :: Table ()
+tellBreak = Table $ \r s ac -> let next = formatBreak r
+                               in (s, ac `snocH` next, ())
+
+-- | Run the Table monad with a local ColumnSpecs, cf. the
+-- @local@ function of the Reader monad class.
+--
+localColumns :: ColumnSpecs -> Table a -> Table a
+localColumns r1 ma = Table $ \_ s ac -> getTable ma r1 s ac
+
+
+-- | Proceed to the next track - reset running time.
+--
+nextTrack :: Table ()
+nextTrack = Table $ \_ s ac -> (upd s, ac, ())
+  where
+    upd = (\s n -> s { get_tracknum = n+1, get_acctime = 0}) <*> get_tracknum
+
+
+
+-- | Proceed to an arbitrary track - reset running time.
+--
+arbTrack :: Int -> Table ()
+arbTrack n = Table $ \_ _ ac -> 
+    (St { get_tracknum = n, get_acctime = 0}, ac, ())
+
+
+
+-- | Increment runninf time.
+--
+incrDelta :: Integer -> Table ()
+incrDelta dt = Table $ \_ s ac -> (upd s, ac, ())
+  where
+    upd = (\s n -> s { get_acctime = n + dt }) <*> get_acctime
+
+-- | Helper for generating a line break
+--
+formatBreak :: ColumnSpecs -> String
+formatBreak spec = replicate (lineLength spec) '-'
+
+
+-- | Helper for generating a row.
+--
+formatRow :: ColumnSpecs -> [WString] -> String
+formatRow (ColumnSpecs ch fmts) ws = fromH $ doch $ step fmts ws
+  where
+    fmt1       = PadL 9
+    -- if run out of formats use default...
+    step []      xs     = step [fmt1] xs
+    step _      []      = mempty
+    step (c:_)  [x]     = format1 c x
+    step (c:cs) (x:xs)  = let d1 = format1 c x; ds = step cs xs
+                          in sep ch d1 ds
+
+-- | Helper for generating a single column.
+--
+format1 :: ColumnSpec -> WString -> WString
+format1 (PadL n) w = if n > width w then padl n w else w
+format1 (PadR n) w = if n > width w then padr n w else w
+
+
+-- | Calculate the line length.
+--
+lineLength :: ColumnSpecs -> Int
+lineLength (ColumnSpecs _ fmts) = step 0 fmts
+  where
+    step w []     = w
+    step w [x]    = w + size x
+    step w (x:xs) = step (w + size x + 1) xs
+
+    size (PadL i) = i
+    size (PadR i) = i
+
+
 -- | Docs represent a single line - they should not contain 
 -- newlines.
 --
-data Doc = Doc { 
+data WString = WString { 
     -- | Width of the doc.
     width :: !Int, 
 
@@ -69,79 +270,87 @@
 
 -- | Make a literal Doc from a String.
 --
-doc :: String -> Doc
-doc s = Doc (length s) (showString s) 
+wstring :: String -> WString
+wstring s = WString (length s) (showString s) 
 
 -- | Unwrap a Doc making a String.
 --
-output :: Doc -> String
-output = fromH . doch
+outputDoc :: WString -> String
+outputDoc = fromH . doch
 
 
+-- | Concatenation is /directly next to/ i.e. no space.
+--
+instance Monoid WString where
+  mempty                                = WString 0 id
+  WString w1 f1 `mappend` WString w2 f2 = WString (w1+w2) (f1 . f2)
 
-instance Monoid Doc where
-  mempty                        = Doc 0 id
-  Doc i1 f1 `mappend` Doc i2 f2 = Doc (i1+i2) (f1 . f2)
 
 
-infixr 6 `cat`
+infixr 6 <+>
 
--- | Concatenate - no space.
+-- | Concatenate two WStrings with a space between them.
 --
-cat :: Doc -> Doc -> Doc
-cat = mappend
+(<+>) :: WString -> WString -> WString
+(<+>) = sep ' '
 
-infixr 6 `sep`
 
--- | Concatenate - with space.
+-- | Concatenate - with a single character separator.
 --
-sep :: Doc -> Doc -> Doc
-sep (Doc i1 f1) (Doc i2 f2) = Doc (1+i1+i2) (f1 . (' ':) . f2)
+sep :: Char -> WString -> WString -> WString
+sep ch (WString w1 f1) (WString w2 f2) = WString (1+w1+w2) (f1 . (ch:) . f2)
 
 
--- | Make a Doc from a Char.
+-- | Make a WString from a Char.
 --
-char :: Char -> Doc 
-char c = Doc 1 (c:)
+char :: Char -> WString 
+char c = WString 1 (c:)
 
--- | Make a Doc from a String.
+-- | Make a WString from a String.
 --
-text :: String -> Doc
-text = doc 
+text :: String -> WString
+text = wstring
 
--- | Repeat the Char /n/ times to make a Doc.
+-- | Repeat the Char /n/ times to make a WString.
 --
-repeatChar :: Int -> Char -> Doc
-repeatChar n c = Doc n (showString $ replicate n c)
+repeatChar :: Int -> Char -> WString
+repeatChar n c = WString n (showString $ replicate n c)
 
 
 -- | Pad the left with space.
 --
-padl :: Int -> Doc -> Doc
-padl i d@(Doc n f) | i > n     = Doc i (spaceH (i-n) . f)
-                   | otherwise = d
+padl :: Int -> WString -> WString
+padl i d@(WString n f) | i > n     = WString i (spaceH (i-n) . f)
+                       | otherwise = d
 
 -- | Pad the right with space.
 --
-padr :: Int -> Doc -> Doc
-padr i d@(Doc n f) | i > n     = Doc i (f . spaceH (i-n))
-                   | otherwise = d
+padr :: Int -> WString -> WString
+padr i d@(WString n f) | i > n     = WString i (f . spaceH (i-n))
+                       | otherwise = d
 
 -- | Show as a two digit hex number.
 --
-hex2 :: Word8 -> Doc
-hex2 n | n < 0x10  = Doc 2 (('0' :) . showHex n)
-       | otherwise = Doc 2 (showHex n)  
+hex2 :: Word8 -> WString
+hex2 n | n < 0x10  = WString 2 (('0' :) . showHex n)
+       | otherwise = WString 2 (showHex n)  
 
 -- | Show as a four digit hex number.
 --
-hex4 :: Word16 -> Doc
-hex4 n | n < 0x10   = Doc 4 (('0':) . ('0':) . ('0':) . showHex n)
-       | n < 0x100  = Doc 4 (('0':) . ('0':) . showHex n)
-       | n < 0x1000 = Doc 4 (('0':) . showHex n)
-       | otherwise = Doc 4 (showHex n)  
+hex4 :: Word16 -> WString
+hex4 n | n < 0x10   = WString 4 (('0':) . ('0':) . ('0':) . showHex n)
+       | n < 0x100  = WString 4 (('0':) . ('0':) . showHex n)
+       | n < 0x1000 = WString 4 (('0':) . showHex n)
+       | otherwise  = WString 4 (showHex n)  
 
+
+-- | Show an Int as a base 10 number.
+--
+int :: Int -> WString
+int = wstring . show 
+
+
 -- | Show an Integral value as a base 10 number.
 --
-integral :: (Show a, Integral a) => a -> Doc
-integral = doc . show 
+integral :: (Show a, Integral a) => a -> WString
+integral = wstring . show 
diff --git a/src/ZMidi/Core/Pretty.hs b/src/ZMidi/Core/Pretty.hs
--- a/src/ZMidi/Core/Pretty.hs
+++ b/src/ZMidi/Core/Pretty.hs
@@ -3,7 +3,7 @@
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  ZMidi.Core.Pretty
--- Copyright   :  (c) Stephen Tetley 2010-2012
+-- Copyright   :  (c) Stephen Tetley 2010-2013
 -- License     :  BSD3
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
@@ -24,8 +24,8 @@
 module ZMidi.Core.Pretty
   (
 
-    printMidi
-
+    putMidi
+  , printMidi
   , printMidiHeader
   , printMidiTrack
 
@@ -33,25 +33,29 @@
 
 import ZMidi.Core.Datatypes
 import ZMidi.Core.Internal.SimpleFormat
+import ZMidi.Core.Pretty.Internal
+import ZMidi.Core.Pretty.Interp
 
-import Data.Char
-import Data.List
 import Data.Monoid
-import Data.Word
 
+-- | Print the MIDI file to stdout.
+--
+-- One event is printed per line, so the output may be large.
+--
+putMidi :: MidiFile -> IO ()
+putMidi = mapM_ putStrLn . printMidi
 
--- | Print the MIDI file to std-out.
+
+-- | Print the MIDI file to a list of Strings.
 --
--- One event is printed per line, so the output may be huge.
+-- Results are returned as a list of String to avoid extraneous
+-- concatenation.
 --
-printMidi :: MidiFile -> IO ()
-printMidi (MidiFile hdr tracks) = do
-    column_break
-    mapM_ putStrLn (printMidiHeader hdr)  
-    mapM_ (\t -> column_break >> putTrack t) tracks
-  where
-    putTrack       = (mapM_ putStrLn) . printMidiTrack
-    column_break   = putStrLn $ replicate 60 '-'
+printMidi :: MidiFile -> [String]
+printMidi (MidiFile hdr tracks) = execTable body_columns $ do 
+    tellBreak
+    tellMidiHeader hdr
+    mapM_ (\t -> tellBreak >> tellTrack t) $ tracks
 
 
 -- | Print the MIDI header.
@@ -59,190 +63,225 @@
 -- Results are returned as a list of String to avoid extraneous
 -- concatenation.
 -- 
-printMidiHeader :: MidiHeader -> [String]
-printMidiHeader (MidiHeader fmt tcount td) = 
-   map output [ppFormat fmt, ppNumTracks tcount, ppTimeDivision td]  
+printMidiHeader :: MidiFile -> [String]
+printMidiHeader (MidiFile hdr _) = execTable body_columns $ tellMidiHeader hdr
 
+
 -- | Print a track.
 --
 -- Results are returned as a list of String to avoid extraneous
 -- concatenation.
 --
-printMidiTrack :: MidiTrack -> [String]
-printMidiTrack = snd . mapAccumL fn 0 . getTrackMessages 
+printMidiTrack :: Int -> MidiFile -> [String]
+printMidiTrack track_num (MidiFile _ trks) = 
+    case findTrack track_num trks of
+      Just trk -> execTable body_columns $ tellArbTrack track_num trk
+      Nothing  -> ["*** ERROR *** cannot find track " ++ show track_num ]
   where
-    fn acc b     = msnd output $ message acc b
-    msnd f (a,b) = (a,f b)
+    -- Numbering starts from 1..
+    findTrack 1 (t:_)           = Just t
+    findTrack n (_:ts) | n > 1  = findTrack (n-1) ts
+    findTrack _ _               = Nothing
 
---------------------------------------------------------------------------------
 
-column2 :: String -> Doc -> Doc
-column2 s d2 = padr 20 (text s) `cat` char '|' `sep` d2 
 
-ppFormat :: MidiFormat -> Doc
-ppFormat = column2 "MIDI Format" . step 
-  where
-    step MF0  = text "Type 0 MIDI File"
-    step MF1  = text "Type 1 MIDI File"
-    step MF2  = text "Type 2 MIDI File"
+--------------------------------------------------------------------------------
+-- 
 
-ppNumTracks :: Word16 -> Doc
-ppNumTracks = column2 "Number of tracks" . integral
+-- | Helper for printing arbitrary tracks.
+--
+tellArbTrack :: Int -> MidiTrack -> Table ()
+tellArbTrack track_num (MidiTrack xs) = arbTrack track_num >> mapM_ message xs
 
-ppTimeDivision :: MidiTimeDivision -> Doc
-ppTimeDivision = column2 "Time Division" . step
-  where
-    step (FPS i)   = text "fps"   `sep` integral i
-    step (TPB i)   = text "ticks" `sep` integral i
 
-infixr 7 `dashsep`
+-- | Increment the track number (in the monad) and write a track.
+--
+tellTrack :: MidiTrack -> Table ()
+tellTrack (MidiTrack xs) = nextTrack >> mapM_ message xs
 
-dashsep :: Doc -> Doc -> Doc
-dashsep d1 d2 = d1 `sep` char '-' `sep` d2
+    
 
-message :: Word32 -> MidiMessage -> (Word32,Doc)
-message acc (delta,evt) = 
-    (n, acctime `dashsep` dtime `dashsep` ppEvent evt)
-  where
-    n       = acc + fromIntegral delta 
-    acctime = padl 12 (integral n)
-    dtime   = padl 6  (integral delta)
+-- | Column specs for the track tables.
+--
+body_columns :: ColumnSpecs
+body_columns = 
+    ColumnSpecs '|' [ PadR 3, PadL 14, PadL 11, PadR 23, PadR 23 ]
 
-ppEvent :: MidiEvent -> Doc
-ppEvent (MidiEventOther e)    = ppMidiDataOther e
-ppEvent (VoiceEvent rs e)     = ppVoiceEvent rs e
-ppEvent (SysExEvent e)        = ppSysExEvent e
-ppEvent (SysCommonEvent e)    = ppSysCommonEvent e
-ppEvent (SysRealTimeEvent e)  = ppSysRealTimeEvent e
-ppEvent (MetaEvent e)         = ppMetaEvent e
 
+-- | Log a message using the internal Writer of the Table monad.
+--
+message :: MidiMessage -> Table ()
+message (delta,evt) = do 
+    incrDelta $ fromIntegral delta
+    tellRow $ \track_num acctime -> [ integral track_num
+                                    , integral acctime
+                                    , integral delta
+                                    , descEvent evt
+                                    , valEvent evt ]
+    
 
-event :: String -> Doc -> Doc
-event s d = padr 18 (text s) `dashsep` d
+--------------------------------------------------------------------------------
+-- Description column
 
-ppMidiDataOther :: MidiDataOther -> Doc
-ppMidiDataOther (MidiDataOther n)     = event "midi data other" (hex2 n)
+-- | Get description text.
+--
+descEvent :: MidiEvent -> WString
+descEvent (MidiEventOther e)    = descDataOther e
+descEvent (VoiceEvent rs e)     = descVoiceEvent rs e
+descEvent (SysExEvent e)        = descSysExEvent e
+descEvent (SysCommonEvent e)    = descSysCommonEvent e
+descEvent (SysRealTimeEvent e)  = descSysRealTimeEvent e
+descEvent (MetaEvent e)         = descMetaEvent e
 
 
--- | Voice event needs RunningStatus...
+-- | Get description text.
+--
+descDataOther :: MidiDataOther -> WString
+descDataOther (MidiDataOther {})  = text "midi data other"
 
-ppVoiceEvent :: MidiRunningStatus -> MidiVoiceEvent -> Doc
-ppVoiceEvent _  (Controller c n v)     = 
-    event "controller" (hex2 c `sep` hex2 n `sep` hex2 v)
 
-ppVoiceEvent _  (ProgramChange c n)    = 
-    event "program-change" (hex2 c `sep` hex2 n)
+-- | Get description text.
+--
+descVoiceEvent :: MidiRunningStatus -> MidiVoiceEvent -> WString
+descVoiceEvent _  (Controller {})     = text "controller"
+descVoiceEvent _  (ProgramChange {})  = text "program-change"
+descVoiceEvent _  (NoteOff {})        = text "note-off"  
+descVoiceEvent rs (NoteOn _ _ v)      
+    | rs == RS_ON && v == 0               = text "note-on *RS,V0*"
+    | otherwise                           = text "note-on"
 
-ppVoiceEvent _ (NoteOff c n v)        =
-    event "note-off" (hex2 c `sep` hex2 n `sep` hex2 v)
 
-ppVoiceEvent rs (NoteOn c n v)         
-    | rs == RS_ON && v == 0 = event "note-off (RS,V0)" 
-                                    (hex2 c `sep` hex2 n `sep` hex2 v)
-    | otherwise = event "note-on" (hex2 c `sep` hex2 n `sep` hex2 v)
+-- | Get description text.
+--
+descVoiceEvent _  (NoteAftertouch {}) = text "note-aftertouch"
+descVoiceEvent _  (ChanAftertouch {}) = text "channel-aftertouch"
+descVoiceEvent _  (PitchBend {})      = text "pitch-bend"
 
 
-ppVoiceEvent _  (NoteAftertouch c n v) =
-    event "note-aftertouch" (hex2 c `sep` hex2 n `sep` hex2 v)
+-- | Get description text.
+--
+descSysExEvent :: MidiSysExEvent -> WString
+descSysExEvent (SysExSingle {}) = text "sys-ex"
+descSysExEvent (SysExCont {})   = text "sys-ex cont"
+descSysExEvent (SysExEscape {}) = text "sys-ex F7"
 
-ppVoiceEvent _  (ChanAftertouch c v)   = 
-    event "channel-aftertouch" (hex2 c `sep` hex2 v)
 
-ppVoiceEvent _  (PitchBend c v)        =
-    event "pitch-bend" (hex2 c `sep` hex4 v)
+-- | Get description text.
+--
+descSysCommonEvent :: MidiSysCommonEvent -> WString
+descSysCommonEvent (QuarterFrame {})    = text "time-code-1/4-frame"
+descSysCommonEvent (SongPosPointer {})  = text "song position ptr"
+descSysCommonEvent (SongSelect {})      = text "song-select"
+descSysCommonEvent (UndefinedF4)        = text "undefined 0xF4"
+descSysCommonEvent (UndefinedF5)        = text "undefined 0xF5"
+descSysCommonEvent (TuneRequest)        = text "tune-request"
+descSysCommonEvent (EOX)                = text "end-of-sys-ex"
 
 
-ppSysExEvent :: MidiSysExEvent -> Doc
-ppSysExEvent (SysEx n ws) = event "sys-ex" $ byteList n ws
+-- | Get description text.
+--
+descSysRealTimeEvent :: MidiSysRealTimeEvent -> WString
+descSysRealTimeEvent (TimingClock)      = text "sysRT timing-clock"
+descSysRealTimeEvent (UndefinedF9)      = text "sysRT 0xF9"
+descSysRealTimeEvent (StartSequence)    = text "sysRT start seq."
+descSysRealTimeEvent (ContinueSequence) = text "sysRT continue"
+descSysRealTimeEvent (StopSequence)     = text "sysRT stop seq."
+descSysRealTimeEvent (UndefinedFD)      = text "sysRT 0xFD"
+descSysRealTimeEvent (ActiveSensing)    = text "sysRT active sensing"
+descSysRealTimeEvent (SystemReset)      = text "sysRT reset"
 
 
-ppSysCommonEvent :: MidiSysCommonEvent -> Doc
-ppSysCommonEvent (QuarterFrame sb)      = 
-    event "time-code-quarter-frame" (hex2 sb)
+-- | Get description text.
+--
+descMetaEvent :: MidiMetaEvent -> WString
+descMetaEvent (TextEvent ty _)        = text $ textType ty
+descMetaEvent (SequenceNumber {})     = text "sequence-number"
+descMetaEvent (ChannelPrefix {})      = text "channel-prefix"
+descMetaEvent (MidiPort {})           = text "midi-port"
+descMetaEvent (EndOfTrack)            = text "end-of-track"
+descMetaEvent (SetTempo {})           = text "set-tempo"
+descMetaEvent (SMPTEOffset {})        = text "smpte-offest"
+descMetaEvent (TimeSignature {})      = text "time-signature"
+descMetaEvent (KeySignature {})       = text "key-signature"
+descMetaEvent (SSME {})               = text "sequencer-specific"
+descMetaEvent (MetaOther {})          = text "meta-other"
 
-ppSysCommonEvent (SongPosPointer a b)   = 
-    event "sys-common song pos. pointer" (hex2 a `sep` hex2 b)
 
-ppSysCommonEvent (SongSelect w)         = event "song-select" (hex2 w)
+--------------------------------------------------------------------------------
+-- Value column
 
-ppSysCommonEvent (UndefinedF4)          = text "undefined 0xF4"
+-- | Get formatted value.
+--
+valEvent :: MidiEvent -> WString
+valEvent (MidiEventOther e)    = valDataOther e
+valEvent (VoiceEvent _ e)      = valVoiceEvent e
+valEvent (SysExEvent e)        = valSysExEvent e
+valEvent (SysCommonEvent e)    = valSysCommonEvent e
+valEvent (SysRealTimeEvent e)  = valSysRealTimeEvent e
+valEvent (MetaEvent e)         = valMetaEvent e
 
-ppSysCommonEvent (UndefinedF5)          = text "undefined 0xF5"
 
-ppSysCommonEvent (TuneRequest)          = text "tune-request"
+-- | Get formatted value.
+--
+valDataOther :: MidiDataOther -> WString
+valDataOther (MidiDataOther n)   = hex2 n
 
-ppSysCommonEvent (EOX)                  = text "end-of-sys-ex"
 
+-- | Get formatted value.
+--
+valVoiceEvent :: MidiVoiceEvent -> WString
+valVoiceEvent (Controller c n v)      = hex2 c <+> hex2 n <+> hex2 v
+valVoiceEvent (ProgramChange c n)     = hex2 c <+> hex2 n
+valVoiceEvent (NoteOff c n v)         = hex2 c <+> hex2 n <+> hex2 v
+valVoiceEvent (NoteOn c n v)          = hex2 c <+> hex2 n <+> hex2 v
+valVoiceEvent (NoteAftertouch c n v)  = hex2 c <+> hex2 n <+> hex2 v
+valVoiceEvent (ChanAftertouch c v)    = hex2 c <+> hex2 v
+valVoiceEvent (PitchBend c v)         = hex2 c <+> hex4 v
 
-ppSysRealTimeEvent :: MidiSysRealTimeEvent -> Doc
-ppSysRealTimeEvent (TimingClock)        = text "sys-real-time timing-clock"
-ppSysRealTimeEvent (UndefinedF9)        = text "sys-real-time 0xF9"
-ppSysRealTimeEvent (StartSequence)      = text "sys-real-time start"
-ppSysRealTimeEvent (ContinueSequence)   = text "sys-real-time continue"
-ppSysRealTimeEvent (StopSequence)       = text "sys-real-time stop"
-ppSysRealTimeEvent (UndefinedFD)        = text "sys-real-time 0xFD"
-ppSysRealTimeEvent (ActiveSensing)      = text "sys-real-time active sensing"
-ppSysRealTimeEvent (SystemReset)        = text "system-reset"
 
+-- | Get formatted value.
+--
+valSysExEvent :: MidiSysExEvent -> WString
+valSysExEvent (SysExSingle n ws) = byteList n ws
+valSysExEvent (SysExCont n ws _) = byteList n ws
+valSysExEvent (SysExEscape n ws) = byteList n ws
 
-ppMetaEvent :: MidiMetaEvent -> Doc
-ppMetaEvent (TextEvent ty s)          = event (textType ty) (text $ safeString s)
 
-ppMetaEvent (SequenceNumber w)        = event "sequence-number" (hex4 w)
+-- | Get formatted value.
+--
+valSysCommonEvent :: MidiSysCommonEvent -> WString
+valSysCommonEvent (QuarterFrame sb)       = hex2 sb
+valSysCommonEvent (SongPosPointer a b)    = hex2 a <+> hex2 b
+valSysCommonEvent (SongSelect w)          = hex2 w
+valSysCommonEvent (UndefinedF4)           = mempty
+valSysCommonEvent (UndefinedF5)           = mempty
+valSysCommonEvent (TuneRequest)           = mempty
+valSysCommonEvent (EOX)                   = mempty
 
-ppMetaEvent (ChannelPrefix a b)       = 
-    event "channel-prefix" (hex2 a `sep` hex2 b)
 
-ppMetaEvent (MidiPort w)              = event "midi-port" (hex2 w)
-
-ppMetaEvent (EndOfTrack)              = text "end-of-track"
-
-ppMetaEvent (SetTempo w)              = event "set-tempo" (integral w) 
-
-ppMetaEvent (SMPTEOffset h m s f sf)  = 
-    event "smpte-offest" (mconcat $ map hex2 [h,m,s,f,sf])
-
-ppMetaEvent (TimeSignature n d m t)   = 
-    event "time-signature" (mconcat $ map hex2 [n,d,m,t])
-
-ppMetaEvent (KeySignature n sc)       = 
-    event "key-signature" (integral n `sep` ppScale sc)
-
-ppMetaEvent (SSME n ws)               = 
-    event "sequencer-specific" (byteList n ws)
-
-ppMetaEvent (MetaOther ty len ws)     =
-    event "meta-other" (hex2 ty `sep` byteList len ws)
-
-byteList :: (Show a, Integral a) => a -> [Word8] -> Doc 
-byteList n ws | n < 10    = integral n `cat` mconcat (map hex2 ws)
-              | otherwise = integral n `cat` repeatChar 10 '.'
+-- | Get formatted value.
+--
+valSysRealTimeEvent :: MidiSysRealTimeEvent -> WString
+valSysRealTimeEvent _                   = mempty
 
 
-textType :: MidiTextType -> String
-textType GENERIC_TEXT         =  "generic-text" 
-textType COPYRIGHT_NOTICE     =  "copyright-notice"  
-textType SEQUENCE_NAME        =  "sequence-name"
-textType INSTRUMENT_NAME      =  "instrument-name"
-textType LYRICS               =  "lyrics"
-textType MARKER               =  "marker"
-textType CUE_POINT            =  "cue-point"
-  
-
-ppScale :: MidiScaleType -> Doc
-ppScale (MAJOR)         = text "major"
-ppScale (MINOR)         = text "minor"
-ppScale (SCALE_OTHER i) = text "unrecognized scale" `sep` hex2 i
+-- | Get formatted value.
+--
+valMetaEvent :: MidiMetaEvent -> WString
+valMetaEvent (TextEvent _ s)           = text $ safeString s
+valMetaEvent (SequenceNumber w)        = hex4 w
+valMetaEvent (ChannelPrefix ch)        = hex2 ch
+valMetaEvent (MidiPort w)              = hex2 w
+valMetaEvent (EndOfTrack)              = mempty
+valMetaEvent (SetTempo w)              = integral w
+valMetaEvent (SMPTEOffset h m s f sf)  = mconcat $ map hex2 [h,m,s,f,sf]
+valMetaEvent (TimeSignature n d m t)   = 
+      let tsig = text $ timeSignatureName (fromIntegral n) (fromIntegral d)
+      in tsig <+> hex2 m <+> hex2 t
 
+valMetaEvent (KeySignature n sc)       = 
+      maybe (text "unrecognized") text $ midiScaleName sc (fromIntegral n)
 
--- | This is a temporary hack - characters above ASCII 163
--- cause an (invalid character) error when written to stdout.
---
--- Make the string safe.
---
-safeString :: String -> String
-safeString = map (f . ord) 
-  where
-    f i | i < 164   = chr i
-        | otherwise = '#'
+valMetaEvent (SSME n ws)               = byteList n ws
+valMetaEvent (MetaOther ty len ws)     = hex2 ty <+> byteList len ws
 
diff --git a/src/ZMidi/Core/Pretty/Ascii.hs b/src/ZMidi/Core/Pretty/Ascii.hs
new file mode 100644
--- /dev/null
+++ b/src/ZMidi/Core/Pretty/Ascii.hs
@@ -0,0 +1,222 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  ZMidi.Core.Pretty.Ascii
+-- Copyright   :  (c) Stephen Tetley 2013
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  unstable
+-- Portability :  As per dependencies.
+--
+-- Pretty print MIDI in format based on the /ASCII format/
+-- in the book /Beyond MIDI/.
+-- 
+--------------------------------------------------------------------------------
+
+
+module ZMidi.Core.Pretty.Ascii
+  (
+
+    putAscii
+  , printAscii
+
+  ) where
+
+import ZMidi.Core.Datatypes
+import ZMidi.Core.Internal.SimpleFormat
+import ZMidi.Core.Pretty.Internal
+import ZMidi.Core.Pretty.Interp
+
+import Data.Monoid
+import Data.Word
+
+
+-- | Print the MIDI file to stdout (ASCII format based on 
+-- output in the book Beyond MIDI).
+--
+-- One event is printed per line, so the output may be large.
+--
+putAscii :: MidiFile -> IO ()
+putAscii = mapM_ putStrLn . printAscii
+
+
+-- | Print the MIDI file to a list of Strings (ASCII format based
+-- on output in the book Beyond MIDI).
+--
+-- Results are returned as a list of String to avoid extraneous
+-- concatenation.
+--
+printAscii :: MidiFile -> [String]
+printAscii (MidiFile hdr tracks) = execTable body_columns $ do 
+    tellBreak
+    tellMidiHeader hdr
+    tellBreak
+    mapM_ (\t -> columnHeaders >> tellBreak >> tellTrack t >> tellBlank ) 
+          tracks
+
+
+
+
+--------------------------------------------------------------------------------
+
+
+-- | Increment the track number (in the monad) and write a track.
+--
+tellTrack :: MidiTrack -> Table ()
+tellTrack (MidiTrack xs) = nextTrack >> mapM_ message xs
+    
+
+-- | Column specs for the track tables.
+--
+body_columns :: ColumnSpecs
+body_columns = 
+    ColumnSpecs ' ' [ PadR 3    -- track no
+                    , PadR 15   -- event type
+                    , PadR 7    -- note name
+                    , PadL 7    -- key no
+                    , PadL 11   -- delta time
+                    , PadL 13   -- elapsed time
+                    , PadL 9    -- dynamic level (velocity)  
+                    ]
+-- Note 
+-- Numbers generally look better PadL.
+
+
+-- | Log a message using the internal Writer of the Table monad.
+--
+message :: MidiMessage -> Table ()
+message (delta,evt) = do 
+    incrDelta $ fromIntegral delta
+    tellRow $ \track_num acctime -> [ integral track_num
+                                    , descEvent evt
+                                    , eventNoteName evt
+                                    , eventKeyNumber evt
+                                    , integral delta
+                                    , integral acctime
+                                    , eventVelocity evt
+                                    ]
+
+-- | Log column headers.
+--
+columnHeaders :: Table ()
+columnHeaders = tellRow $ \_ _ -> 
+    map text [ "Trk"
+             , "Event Type"
+             , "Note" 
+             , "Key no"
+             , "Delta Time"
+             , "Elapsed Time"
+             , "Velocity"  
+             ]
+
+--------------------------------------------------------------------------------
+-- Event type
+
+
+-- | Get the event type (description).
+--
+descEvent :: MidiEvent -> WString
+descEvent (VoiceEvent rs e)     = descVoiceEvent rs e
+descEvent (MetaEvent e)         = descMetaEvent e
+descEvent _                     = mempty
+
+
+-- | Get the event type (description).
+--
+descVoiceEvent :: MidiRunningStatus -> MidiVoiceEvent -> WString
+descVoiceEvent _  (Controller {})     = text "Controller"
+descVoiceEvent _  (ProgramChange {})  = text "Program change"
+descVoiceEvent _  (NoteOff {})        = text "Note off"  
+descVoiceEvent rs (NoteOn _ _ v)      
+    | rs == RS_ON && v == 0           = text "Note on*"
+    | otherwise                       = text "Note on"
+
+descVoiceEvent _  (NoteAftertouch {}) = text "Note aftertouch"
+descVoiceEvent _  (ChanAftertouch {}) = text "Channel aftertouch"
+descVoiceEvent _  (PitchBend {})      = text "Pitch bend"
+
+
+-- | Get the event type (description).
+--
+descMetaEvent :: MidiMetaEvent -> WString
+descMetaEvent (TextEvent ty _)        = text $ textType ty
+descMetaEvent (SequenceNumber {})     = text "Sequence number"
+descMetaEvent (ChannelPrefix {})      = text "Channel prefix"
+descMetaEvent (MidiPort {})           = text "Midi port"
+descMetaEvent (EndOfTrack)            = text "End of track"
+descMetaEvent (SetTempo {})           = text "Set tempo"
+descMetaEvent (SMPTEOffset {})        = text "SMTPE offest"
+descMetaEvent (TimeSignature {})      = text "Time signature"
+descMetaEvent (KeySignature {})       = text "Key signature"
+descMetaEvent (SSME {})               = text "SSME"
+descMetaEvent (MetaOther {})          = text "Meta other"
+
+
+--------------------------------------------------------------------------------
+-- Note Name
+
+-- | Get the symbolic note name.
+--
+eventNoteName :: MidiEvent -> WString
+eventNoteName (VoiceEvent _ e)     = voiceEventNoteName e
+eventNoteName _                    = mempty
+
+-- | Helper.
+--
+noteName :: Word8 -> WString
+noteName = text . simpleNoteName . fromIntegral
+
+-- | Get the symbolic note name.
+--
+voiceEventNoteName :: MidiVoiceEvent -> WString
+voiceEventNoteName (Controller _ n _)      = noteName n
+voiceEventNoteName (ProgramChange _ n)     = noteName n
+voiceEventNoteName (NoteOff _ n _)         = noteName n
+voiceEventNoteName (NoteOn _ n _)          = noteName n
+voiceEventNoteName (NoteAftertouch _ n _)  = noteName n
+voiceEventNoteName (ChanAftertouch _ _)    = mempty
+voiceEventNoteName (PitchBend _ _)         = mempty
+
+
+--------------------------------------------------------------------------------
+-- Key Number
+
+-- | Get the key number (aka MIDI pitch).
+--
+eventKeyNumber :: MidiEvent -> WString
+eventKeyNumber (VoiceEvent _ e)     = voiceEventKeyNumber e
+eventKeyNumber _                    = mempty
+
+-- | Get the key number (aka MIDI pitch).
+--
+voiceEventKeyNumber :: MidiVoiceEvent -> WString
+voiceEventKeyNumber (Controller _ n _)      = integral n
+voiceEventKeyNumber (ProgramChange _ n)     = integral n 
+voiceEventKeyNumber (NoteOff _ n _)         = integral n 
+voiceEventKeyNumber (NoteOn _ n _)          = integral n
+voiceEventKeyNumber (NoteAftertouch _ n _)  = integral n
+voiceEventKeyNumber (ChanAftertouch _ _)    = mempty
+voiceEventKeyNumber (PitchBend _ _)         = mempty
+
+--------------------------------------------------------------------------------
+-- Velocity
+
+-- | Get the velocity.
+--
+eventVelocity :: MidiEvent -> WString
+eventVelocity (VoiceEvent _ e)     = voiceEventVelocity e
+eventVelocity _                    = mempty
+
+
+-- | Get the velocity.
+--
+voiceEventVelocity :: MidiVoiceEvent -> WString
+voiceEventVelocity (Controller _ _ v)      = integral v
+voiceEventVelocity (ProgramChange _ _)     = mempty
+voiceEventVelocity (NoteOff _ _ v)         = integral v 
+voiceEventVelocity (NoteOn _ _ v)          = integral v
+voiceEventVelocity (NoteAftertouch _ _ v)  = integral v
+voiceEventVelocity (ChanAftertouch _ v)    = integral v
+voiceEventVelocity (PitchBend _ v)         = integral v
diff --git a/src/ZMidi/Core/Pretty/Csv.hs b/src/ZMidi/Core/Pretty/Csv.hs
new file mode 100644
--- /dev/null
+++ b/src/ZMidi/Core/Pretty/Csv.hs
@@ -0,0 +1,234 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  ZMidi.Core.Pretty.Csv
+-- Copyright   :  (c) Stephen Tetley 2013
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  unstable
+-- Portability :  As per dependencies.
+--
+-- Pretty print MIDI to CVS format based on @midicsv@.
+--
+--------------------------------------------------------------------------------
+
+
+module ZMidi.Core.Pretty.Csv
+  (
+
+    putCsv
+  , printCsv
+
+  ) where
+
+import ZMidi.Core.Datatypes
+import ZMidi.Core.Internal.SimpleFormat
+import ZMidi.Core.Pretty.Internal
+
+
+import Data.Monoid
+
+
+-- | Print the MIDI file to stdout (CSV format).
+--
+-- One event is printed per line, so the output may be large.
+--
+putCsv :: MidiFile -> IO ()
+putCsv = mapM_ putStrLn . printCsv
+
+
+
+-- | Print the MIDI file to a list of Strings (CSV format).
+--
+-- Results are returned as a list of String to avoid extraneous
+-- concatenation.
+--
+printCsv :: MidiFile -> [String]
+printCsv (MidiFile hdr tracks) = execTable body_columns $ do 
+    tellHeader hdr
+    mapM_ tellTrack tracks
+
+
+
+
+--------------------------------------------------------------------------------
+
+infixr 6 <%>
+
+-- | Concatenate with a comma-space.
+--
+(<%>) :: WString -> WString -> WString
+a <%> b = a <> char ',' <+> b
+
+
+-- | Tell MidiHeader.
+--
+tellHeader :: MidiHeader -> Table ()
+tellHeader (MidiHeader fmt ntrks tdiv) = 
+    tellFree $ \track_num acctime -> 
+        int track_num <%> integral acctime   <%> text "Header" 
+                      <%> int (fromEnum fmt) <%> integral ntrks 
+                      <%> division tdiv
+  where
+    division (FPS n) = integral n
+    division (TPB n) = integral n
+
+
+
+-- | Tell a track.
+--
+tellTrack :: MidiTrack -> Table ()
+tellTrack (MidiTrack xs) = nextTrack >> mapM_ message xs
+    
+
+-- | Body is free-text (not tabular) so specify and arbitrary 
+-- long column.
+--
+body_columns :: ColumnSpecs
+body_columns = 
+    ColumnSpecs ' ' [ PadR 60 ]
+
+
+-- | Log a message.
+--
+message :: MidiMessage -> Table ()
+message (delta,evt) = do
+    incrDelta $ fromIntegral delta
+    tellFree $ \track_num acctime -> 
+        int track_num <%> integral acctime <%> ppEvent evt
+
+
+-- | Decode an Event.
+--
+ppEvent :: MidiEvent -> WString
+ppEvent (MidiEventOther _)    = text "Unrecognized_event_other"
+ppEvent (VoiceEvent _ e)      = ppVoiceEvent e
+ppEvent (SysExEvent e)        = ppSysExEvent e
+ppEvent (SysCommonEvent e)    = ppSysCommonEvent e
+ppEvent (SysRealTimeEvent e)  = ppSysRealTimeEvent e
+ppEvent (MetaEvent e)         = ppMetaEvent e
+
+-- | Decode a VoiceEvent.
+--
+ppVoiceEvent :: MidiVoiceEvent -> WString
+ppVoiceEvent (Controller c n v)     = 
+    text "Control_c" <%> integral c <%> integral n <%> integral v
+
+ppVoiceEvent (ProgramChange c n)    =
+    text "Program_c" <%> integral c <%> integral n
+
+ppVoiceEvent (NoteOff c n v)         =
+    text "Note_off_c" <%> integral c <%> integral n <%> integral v
+
+ppVoiceEvent (NoteOn c n v)          =
+    text "Note_on_c" <%> integral c <%> integral n <%> integral v
+
+ppVoiceEvent (NoteAftertouch c n v)  =
+    text "Poly_aftertouch_c" <%> integral c <%> integral n <%> integral v
+
+ppVoiceEvent (ChanAftertouch c v)    =
+    text "Channel_aftertouch_c" <%> integral c <%> integral v
+
+ppVoiceEvent (PitchBend c v)         = 
+    text "Pitch_bend_c" <%> integral c <%> integral v
+
+
+
+-- | Decode a SysEx Event.
+--
+ppSysExEvent :: MidiSysExEvent -> WString
+ppSysExEvent (SysExSingle n _) = 
+    text "System_exclusive" <%> integral n <%> text "..."
+
+ppSysExEvent (SysExCont n _ _)  =
+    text "System_exclusive_continuation" <%> integral n <%> text "..."
+
+ppSysExEvent (SysExEscape n _)  =
+    text "System_exclusive_escape" <%> integral n <%> text "..."
+
+
+-- | Decode a SysCommon Event.
+--
+ppSysCommonEvent :: MidiSysCommonEvent -> WString
+ppSysCommonEvent (QuarterFrame sb)       = 
+    text "Quarter_frame_s" <%> integral sb
+
+ppSysCommonEvent (SongPosPointer a b)    =
+    text "Song_position_pointer_s" <%> integral a <%> integral b
+           
+ppSysCommonEvent (SongSelect w)          =
+    text "Song_select_s" <%> integral w
+
+ppSysCommonEvent (UndefinedF4)           = 
+    text "Undefined_s" <%> text "0xF4"
+
+ppSysCommonEvent (UndefinedF5)           = 
+    text "Undefined_s" <%> text "0xF5"
+
+ppSysCommonEvent (TuneRequest)           = 
+    text "Tune_request_s"
+
+ppSysCommonEvent (EOX)                   = 
+    text "EOX_s"
+
+
+
+-- | Decode a SysRealTime Event.
+--
+ppSysRealTimeEvent :: MidiSysRealTimeEvent -> WString
+ppSysRealTimeEvent (TimingClock)       = text "Timing_clock_s"
+ppSysRealTimeEvent (UndefinedF9)       = text "Undefined_s" <%> text "0xF9"
+ppSysRealTimeEvent (StartSequence)     = text "Start_sequence_s" 
+ppSysRealTimeEvent (ContinueSequence)  = text "Continue_sequence_s"
+ppSysRealTimeEvent (StopSequence)      = text "Stop_sequence_s"
+ppSysRealTimeEvent (UndefinedFD)       = text "Undefined_s" <%> text "0xFD"
+ppSysRealTimeEvent (ActiveSensing)     = text "Active_sensing_s"
+ppSysRealTimeEvent (SystemReset)       = text "System_reset_s"
+
+-- | Decode a Meta Event.
+--
+ppMetaEvent :: MidiMetaEvent -> WString
+ppMetaEvent (TextEvent ty s)          = ppTextEvent ty s
+ppMetaEvent (SequenceNumber w)        = text "Sequence_number" <%> integral w
+ppMetaEvent (ChannelPrefix ch)        = text "Channel_prefix" <%> integral ch
+ppMetaEvent (MidiPort w)              = text "MIDI_port" <%> integral w
+ppMetaEvent (EndOfTrack)              = text "End_track"
+ppMetaEvent (SetTempo w)              = text "Tempo" <%> integral w
+ppMetaEvent (SMPTEOffset h m s f sf)  = 
+    text "SMTPE_offset" <%> integral h <%> integral m <%> integral s
+                        <%> integral f <%> integral sf
+
+ppMetaEvent (TimeSignature n d m t)   = 
+    text "Time_signature" <%> integral n <%> integral d 
+                          <%> integral m <%> integral t
+
+ppMetaEvent (KeySignature n sc)       = 
+    let scale = case sc of { MAJOR -> "major"
+                           ; MINOR -> "minor" 
+                           ; _ -> "unrecognized" }
+    in text "Key_signature" <%> integral n <%> text scale
+
+ppMetaEvent (SSME n _)                = 
+    text "Sequencer_specific" <%> integral n <%> text "..."
+
+ppMetaEvent (MetaOther ty len _)      = 
+    text "Unknown_meta_event" <%> integral ty <%> integral len <%> text "..."
+
+
+-- | Avoid pernicious ASCII characters e.g. the copyright symbol.
+--
+safetext :: String -> WString
+safetext = text . safeString
+
+-- | Decode MIDI text.
+--
+ppTextEvent :: MidiTextType -> String -> WString
+ppTextEvent GENERIC_TEXT      s = text "Text_t" <%> safetext s
+ppTextEvent COPYRIGHT_NOTICE  s = text "Copyright_t" <%> safetext s
+ppTextEvent SEQUENCE_NAME     s = text "Sequence_name_t" <%> safetext s
+ppTextEvent INSTRUMENT_NAME   s = text "Instrument_name_t" <%> safetext s
+ppTextEvent LYRICS            s = text "Lyric_t" <%> safetext s
+ppTextEvent MARKER            s = text "marker" <%> safetext s
+ppTextEvent CUE_POINT         s = text "cue-point" <%> safetext s
diff --git a/src/ZMidi/Core/Pretty/Internal.hs b/src/ZMidi/Core/Pretty/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/ZMidi/Core/Pretty/Internal.hs
@@ -0,0 +1,107 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  ZMidi.Core.Pretty.Internal
+-- Copyright   :  (c) Stephen Tetley 2013
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  unstable
+-- Portability :  As per dependencies.
+--
+-- Helper functions to pretty print MIDI as text.
+--
+-- The functionality is unstable and may change between 
+-- releases however it is still exposed as it may be useful
+-- for writing a custom pretty printer. 
+--
+--------------------------------------------------------------------------------
+
+
+module ZMidi.Core.Pretty.Internal
+  (
+
+    midi_header_columns
+  , tellMidiHeader
+
+  , byteList
+  , safeString
+  , textType
+
+  ) where
+
+import ZMidi.Core.Datatypes
+import ZMidi.Core.Internal.SimpleFormat
+
+
+import Data.Char
+import Data.Monoid
+import Data.Word
+
+-- | Column specs for Header - Header is printed as simple 
+-- name-value pairs (2 columns).
+--
+midi_header_columns :: ColumnSpecs 
+midi_header_columns = ColumnSpecs '|' [ PadR 21, PadR 38 ] 
+
+-- | Log the MidiHeader in the Table monad (cf. Writer).
+--
+tellMidiHeader :: MidiHeader -> Table ()
+tellMidiHeader (MidiHeader fmt tcount td) = 
+    localColumns midi_header_columns $ do
+      tellRow $ \_ _ -> [ text "MIDI Format",      ppFormat fmt ]
+      tellRow $ \_ _ -> [ text "Number of tracks", integral tcount ]
+      tellRow $ \_ _ -> [ text "Time Division",    ppTimeDivision td ]
+
+
+-- | Decode MidiFormat.
+--
+ppFormat :: MidiFormat -> WString
+ppFormat MF0  = text "Type 0 MIDI File"
+ppFormat MF1  = text "Type 1 MIDI File"
+ppFormat MF2  = text "Type 2 MIDI File"
+
+-- | Decode TimeDivision.
+--
+ppTimeDivision :: MidiTimeDivision -> WString
+ppTimeDivision (FPS i)   = text "FPS"   <+> integral i
+ppTimeDivision (TPB i)   = text "Ticks" <+> integral i
+
+
+--------------------------------------------------------------------------------
+-- Helpers
+
+
+-- | Print a short byte-list as Hex. Byte-lists longer than 
+-- 10 chars are printed as ellipses.
+--
+byteList :: (Show a, Integral a) => a -> [Word8] -> WString
+byteList n ws | n < 10    = integral n <+> mconcat (map hex2 ws)
+              | otherwise = integral n <+> repeatChar 10 '.'
+
+
+-- | Decode Text Type
+--
+textType :: MidiTextType -> String
+textType GENERIC_TEXT         =  "generic-text" 
+textType COPYRIGHT_NOTICE     =  "copyright-notice"  
+textType SEQUENCE_NAME        =  "sequence-name"
+textType INSTRUMENT_NAME      =  "instrument-name"
+textType LYRICS               =  "lyrics"
+textType MARKER               =  "marker"
+textType CUE_POINT            =  "cue-point"
+  
+
+-- | Make a string safe for stdout.
+-- 
+-- This is a temporary hack - characters above ASCII 163
+-- cause an (invalid character) error when written to stdout 
+-- on Windows (Cygwin).
+--
+safeString :: String -> String
+safeString = map (f . ord) 
+  where
+    f i | i < 164   = chr i
+        | otherwise = '#'
+
diff --git a/src/ZMidi/Core/Pretty/Interp.hs b/src/ZMidi/Core/Pretty/Interp.hs
new file mode 100644
--- /dev/null
+++ b/src/ZMidi/Core/Pretty/Interp.hs
@@ -0,0 +1,141 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  ZMidi.Core.Pretty.Interp
+-- Copyright   :  (c) Stephen Tetley 2013
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  unstable
+-- Portability :  As per dependencies.
+--
+-- Helper functions to pretty print MIDI as text.
+--
+-- The functionality is unstable and may change between 
+-- releases however it is still exposed as it may be useful
+-- for writing a custom pretty printer. 
+--
+--------------------------------------------------------------------------------
+
+
+module ZMidi.Core.Pretty.Interp
+  (
+
+    ScaleMap
+  , scale_map
+
+  , majorScaleName
+  , minorScaleName
+
+  , midiScaleName
+
+  , simpleNoteName
+
+  , timeSignature
+  , timeSignatureName
+
+  ) where
+
+
+import ZMidi.Core.Datatypes
+
+import qualified Data.IntMap as IM
+import Data.Ratio
+
+
+-- | Representation of scales mapping the number of accidentals 
+-- to (major,minor) key names.
+--
+type ScaleMap = IM.IntMap (String,String)
+
+-- | Populated ScaleMap.
+--
+-- Positive numbers are number of sharps
+-- Negative numbers are number of flats.
+--
+scale_map :: ScaleMap
+scale_map = IM.fromList $ 
+    [ (0,  ("C",  "A" ))
+    , (1,  ("G",  "E" ))
+    , (2,  ("D",  "B" ))
+    , (3,  ("A",  "F#"))
+    , (4,  ("E",  "C#"))
+    , (5,  ("B",  "G#"))
+    , (6,  ("F#", "D#"))
+    , (7,  ("C#", "A#"))
+    , (-1, ("F",  "D" ))
+    , (-2, ("Bb", "G" ))
+    , (-3, ("Eb", "C" ))
+    , (-4, ("Ab", "F" ))
+    , (-5, ("Db", "Bb"))
+    , (-6, ("Gb", "Eb"))
+    , (-7, ("Cb", "Ab"))
+    ] 
+
+-- | Decode major scale name.
+--
+majorScaleName :: Int -> Maybe String
+majorScaleName n = fmap (\(ss,_) -> ss ++ " major") $ IM.lookup n scale_map
+
+   
+-- | Decode minor scale name.
+--
+minorScaleName :: Int -> Maybe String
+minorScaleName n = fmap (\(_,ss) -> ss ++ " minor") $ IM.lookup n scale_map
+
+
+-- | Decode scale name.
+--
+midiScaleName :: MidiScaleType -> Int -> Maybe String
+midiScaleName (MAJOR) n = majorScaleName n
+midiScaleName (MINOR) n = minorScaleName n
+midiScaleName _       _ = Nothing
+
+
+
+-- | Decode simple note name.
+--
+-- Follows the example of the book /Beyond MIDI/ - there is 
+-- no enharmonic spelling, all black key notes are named as 
+-- their respective sharp note.
+-- 
+simpleNoteName :: Int -> String
+simpleNoteName n = 
+    let (o,l) = n `divMod` 12 
+        ove   = show $ o - 1
+    in pch l ++ ove
+  where
+    pch  0 = "C"
+    pch  1 = "C#"
+    pch  2 = "D"
+    pch  3 = "D#"
+    pch  4 = "E"
+    pch  5 = "F"
+    pch  6 = "F#"
+    pch  7 = "G"
+    pch  8 = "G#"
+    pch  9 = "A"
+    pch 10 = "A#"
+    pch 11 = "B"
+    pch  _ = "ERROR - simpleNoteName - impossible "
+
+
+-- | Decode a time signature.
+-- 
+-- Returned as (numerator, denoimator) pair.
+--               
+timeSignature :: Int -> Int -> (Int,Int)
+timeSignature nn dd = (nn, d1)
+  where
+    ddi :: Integer
+    ddi = fromIntegral dd
+    d1  :: Int
+    d1  = fromIntegral $ denominator $ (2::Rational) ^^ (negate ddi)
+
+
+-- | Decode a time signature - and print.
+--
+timeSignatureName :: Int -> Int -> String
+timeSignatureName nn dd = 
+    let (ni,di) = timeSignature nn dd in show ni ++ "/" ++ show di
diff --git a/src/ZMidi/Core/ReadFile.hs b/src/ZMidi/Core/ReadFile.hs
--- a/src/ZMidi/Core/ReadFile.hs
+++ b/src/ZMidi/Core/ReadFile.hs
@@ -3,7 +3,7 @@
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  ZMidi.Core.ReadFile
--- Copyright   :  (c) Stephen Tetley 2010-2012
+-- Copyright   :  (c) Stephen Tetley 2010-2013
 -- License     :  BSD3
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
@@ -110,6 +110,7 @@
     step n 
       | n == 0xFF  = MetaEvent         <$> (dropW8 *> (word8 >>= metaEvent))
       | n >= 0xF8  = SysRealTimeEvent  <$> (dropW8 *> sysRealTimeEvent n)
+      | n == 0xF7  = SysExEvent        <$> (dropW8 *> sysExEscape)
       | n >= 0xF1  = SysCommonEvent    <$> (dropW8 *> sysCommonEvent n)
       | n == 0xF0  = SysExEvent        <$> (dropW8 *> sysExEvent)
       | n >= 0x80  = VoiceEvent RS_OFF <$> (dropW8 *> voiceEvent (splitByte n))
@@ -237,9 +238,26 @@
 -- | 0xF0 has been parsed, SysEx is uninterpreted.
 --
 sysExEvent :: ParserM MidiSysExEvent
-sysExEvent = "sys-ex" <??> getVarlenBytes SysEx
+sysExEvent = "sys-ex" <??> body
+  where
+    body = getVarlenBytes (,) >>= \(n,xs) -> 
+           if isTerminated xs then return $ SysExSingle n xs
+                              else sysExContPackets >>= \ks -> 
+                                   return $ SysExCont n xs ks
 
+sysExContPackets :: ParserM [MidiSysExContPacket]
+sysExContPackets = 
+    deltaTime >>= \dt -> getVarlenBytes (,) >>= \(n,xs) -> 
+    let ans1 = MidiSysExContPacket dt n xs
+    in if isTerminated xs then return [ans1]
+                          else sysExContPackets >>= \ks -> 
+                               return $ ans1:ks
 
+
+
+sysExEscape :: ParserM MidiSysExEvent
+sysExEscape = "sys-ex" <??> getVarlenBytes SysExEscape
+
 -- | 0xFF and the "type" byte already parsed, input to this 
 -- function is the type byte.
 --
@@ -259,10 +277,10 @@
 metaEvent 0x07          = "cue point"         <??> textEvent CUE_POINT
 
 metaEvent 0x20          = 
-    "channel prefix"    <??> ChannelPrefix <$> word8 <*> word8
+    "channel prefix"    <??> ChannelPrefix <$> (assertWord8 0x01 *> word8)
 
 metaEvent 0x21          = 
-    "MIDI port"         <??> MidiPort <$> (assertWord8 1 *> word8)
+    "MIDI port"         <??> MidiPort <$> (assertWord8 0x01 *> word8)
 
 metaEvent 0x2F          = 
     "end of track"      <??> EndOfTrack <$ assertWord8 0  
@@ -351,16 +369,20 @@
 getVarlenBytes = gencount getVarlen word8
 
 
+msbHigh :: Word8 -> Bool
+msbHigh w = w `testBit` 7
+
+-- msbLow :: Word8 -> Bool
+-- msbLow = not . msbHigh
+
 getVarlen :: ParserM Word32
 getVarlen = liftM fromVarlen step1
   where
-    high a = a `testBit` 7
-
-    step1     = word8 >>= \a -> if high a then step2 a else return (V1 a)
-    step2 a   = word8 >>= \b -> if high b then step3 a b else return (V2 a b)
-    step3 a b = word8 >>= \c -> if high c then do { d <- word8
-                                                  ; return (V4 a b c d) }
-                                          else return (V3 a b c)  
+    step1     = word8 >>= \a -> if msbHigh a then step2 a else return (V1 a)
+    step2 a   = word8 >>= \b -> if msbHigh b then step3 a b else return (V2 a b)
+    step3 a b = word8 >>= \c -> if msbHigh c then do { d <- word8
+                                                     ; return (V4 a b c d) }
+                                             else return (V3 a b c)  
 
 
 
@@ -371,3 +393,21 @@
 postCheck :: ParserM a -> (a -> Bool) -> String -> ParserM a
 postCheck p check msg = p >>= \ans -> 
     if check ans then return ans else fatalError msg
+
+isTerminated :: [Word8] -> Bool
+isTerminated []     = False
+isTerminated [0xF7] = True
+isTerminated (_:xs) = isTerminated xs
+
+-- | Read a list of databytes.
+-- A stream of databytes is signalled by elements having 
+-- continuous low most-significant bits.
+--
+
+-- databytesMsbLow :: ParserM [Word8]
+-- databytesMsbLow = step
+--    where
+--      step = cond msbLow >>= \mb -> case mb of 
+--               Nothing -> return [] 
+--               Just x -> do { xs <- step; return (x:xs) }
+                                     
diff --git a/src/ZMidi/Core/VersionNumber.hs b/src/ZMidi/Core/VersionNumber.hs
--- a/src/ZMidi/Core/VersionNumber.hs
+++ b/src/ZMidi/Core/VersionNumber.hs
@@ -3,7 +3,7 @@
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  ZMidi.Core.VersionNumber
--- Copyright   :  (c) Stephen Tetley 2010-2012
+-- Copyright   :  (c) Stephen Tetley 2010-2013
 -- License     :  BSD3
 --
 -- Maintainer  :  stephen.tetley@gmail.com
@@ -22,7 +22,7 @@
 
 -- | Version number
 --
--- > (0,6,0)
+-- > (0,7,0)
 --
 zmidi_core_version :: (Int,Int,Int)
-zmidi_core_version = (0,6,0)
+zmidi_core_version = (0,7,0)
diff --git a/src/ZMidi/Core/WriteFile.hs b/src/ZMidi/Core/WriteFile.hs
--- a/src/ZMidi/Core/WriteFile.hs
+++ b/src/ZMidi/Core/WriteFile.hs
@@ -3,7 +3,7 @@
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  ZMidi.Core.WriteFile
--- Copyright   :  (c) Stephen Tetley 2010-2012
+-- Copyright   :  (c) Stephen Tetley 2010-2013
 -- License     :  BSD3
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
@@ -70,9 +70,11 @@
 putTimeDivision (TPB n) = putWord16be (n `clearBit` 15)
 
 
+putDeltaTime :: DeltaTime -> PutM ()
+putDeltaTime = putVarlen . fromIntegral
 
 putMessage :: MidiMessage -> PutM () 
-putMessage (dt,evt) = putVarlen (fromIntegral dt) *> putEvent evt
+putMessage (dt,evt) = putDeltaTime dt *> putEvent evt
 
 putEvent :: MidiEvent -> PutM ()
 putEvent (MidiEventOther e)   = putMidiDataOther  e
@@ -93,53 +95,74 @@
 -- constructor and channel.
 -- 
 putVoiceEvent :: MidiRunningStatus -> MidiVoiceEvent -> PutM ()
-putVoiceEvent rs (NoteOff c n v)         = 
+putVoiceEvent rs (NoteOff c n v)            = 
     optTagByte rs (0x8 `u4l4` c) *> putWord8 n *> putWord8 v 
 
-putVoiceEvent rs (NoteOn c n v)          = 
+putVoiceEvent rs (NoteOn c n v)             = 
     optTagByte rs (0x9 `u4l4` c) *> putWord8 n *> putWord8 v 
 
-putVoiceEvent rs (NoteAftertouch c n v)  = 
+putVoiceEvent rs (NoteAftertouch c n v)     = 
     optTagByte rs (0xA `u4l4` c) *> putWord8 n *> putWord8 v
 
-putVoiceEvent rs (Controller c n v)      = 
+putVoiceEvent rs (Controller c n v)         = 
     optTagByte rs (0xB `u4l4` c) *> putWord8 n *> putWord8 v
 
-putVoiceEvent rs (ProgramChange c n)     = 
+putVoiceEvent rs (ProgramChange c n)        = 
     optTagByte rs (0xC `u4l4` c) *> putWord8 n
 
-putVoiceEvent rs (ChanAftertouch c v)    = 
+putVoiceEvent rs (ChanAftertouch c v)       = 
     optTagByte rs (0xD `u4l4` c) *> putWord8 v  
 
-putVoiceEvent rs (PitchBend c v)         = 
+putVoiceEvent rs (PitchBend c v)            = 
     optTagByte rs (0xE `u4l4` c) *> putWord16be v
 
 
+-- Note - F7 (terminator) should be the last byte in the 
+-- payload (ws) for SysExSingle.
+-- 
+-- It should be the last byte of the last continuation packet
+-- for SysExCont.
+--
+-- The payload for SysExEscape should not be terminated 
+-- (with F7).
+--
 putSysExEvent :: MidiSysExEvent -> PutM ()
-putSysExEvent (SysEx n ws) = 
+putSysExEvent (SysExSingle n ws)    = 
     putWord8 0xF0 *> putVarlen n *> mapM_ putWord8 ws
 
+putSysExEvent (SysExCont n ws ks)   = 
+    putWord8 0xF0 *> putVarlen n *> mapM_ putWord8 ws 
+                  *> mapM_ putSysExContPacket ks
 
+putSysExEvent (SysExEscape n ws)    = 
+    putWord8 0xF7 *> putVarlen n *> mapM_ putWord8 ws
+
+
+putSysExContPacket :: MidiSysExContPacket -> PutM ()
+putSysExContPacket (MidiSysExContPacket dt n ws)  = 
+    putDeltaTime dt *> putWord8 0xF7 *> putVarlen n *> mapM_ putWord8 ws
+    
+
 putSysCommonEvent :: MidiSysCommonEvent -> PutM ()
-putSysCommonEvent (QuarterFrame sb)        = 
+putSysCommonEvent (QuarterFrame sb)         = 
     putWord8 0xF1 *> putWord8 sb
 
-putSysCommonEvent (SongPosPointer lsb msb) = 
+putSysCommonEvent (SongPosPointer lsb msb)  = 
     putWord8 0xF2 *> putWord8 lsb *> putWord8 msb
 
-putSysCommonEvent (SongSelect w)           = 
+putSysCommonEvent (SongSelect w)            = 
     putWord8 0xF3 *> putWord8 w
 
-putSysCommonEvent (UndefinedF4)            = 
+putSysCommonEvent (UndefinedF4)             = 
     putWord8 0xF4
 
-putSysCommonEvent (UndefinedF5)            = 
+putSysCommonEvent (UndefinedF5)             = 
     putWord8 0xF5
 
-putSysCommonEvent TuneRequest              = 
+putSysCommonEvent TuneRequest               = 
     putWord8 0xF6
 
-putSysCommonEvent (EOX)                    = 
+putSysCommonEvent (EOX)                     = 
     putWord8 0xF7
 
 
@@ -163,8 +186,8 @@
 putMetaEvent (SequenceNumber n)               = 
     putWord8 0xFF *> putWord8 0x00 *> prefixLen 2 (putWord16be n)
   
-putMetaEvent (ChannelPrefix i ch)             = 
-    putWord8 0xFF *> putWord8 0x20 *> prefixLen i (putWord8 ch)
+putMetaEvent (ChannelPrefix ch)               = 
+    putWord8 0xFF *> putWord8 0x20 *> putWord8 0x01 *> putWord8 ch
 
 putMetaEvent (MidiPort pn)                     = 
     putWord8 0xFF *> putWord8 0x21 *> putWord8 0x01 *> putWord8 pn
diff --git a/zmidi-core.cabal b/zmidi-core.cabal
--- a/zmidi-core.cabal
+++ b/zmidi-core.cabal
@@ -1,5 +1,5 @@
 name:             zmidi-core
-version:          0.6.0
+version:          0.7.0
 license:          BSD3
 license-file:     LICENSE
 copyright:        Stephen Tetley <stephen.tetley@gmail.com>
@@ -10,10 +10,29 @@
 description:
   .
   Minimalist library to read and write MIDI files, with 
-  dependencies only on ByteString and Data.Binary.
+  dependencies only on ByteString, Containers and Data.Binary.
   .
   Changelog:
   .
+  v0.6.0 to v0.7.0:
+  .
+  * Changed @ChannelPrefix@ constructor to have a single 
+    argument - channel number (previously it stored a constant 
+    tag 0x01 as well as channel number).
+  .
+  * Added @SysExCont@ and @SysExEscape@ constructors to the 
+    @MidiSysExEvent@ data type.
+  .
+  * Added new pretty printers - @Csv@ based on @midicsv@ and 
+    @Ascii@ based on the ASCII MIDI representation in the book 
+    Beyond Midi (the zmidi ASCII representation is simplified).
+    The demo application @MidiPrint@ now allows choice of pretty
+    printer.
+  .
+  * @printMidiHeader@ and @printMidiTrack@ from @Pretty@ changed
+    to MidiFiles as arguments, @printMidi@ has now become 
+    @putMidi@.
+  .
   v0.5.0 to v0.6.0:
   .
   * Extended the parser and changed the syntax tree to interpret 
@@ -29,57 +48,7 @@
     chars greater than 164 causing an error when printing to 
     stdout.
   .
-  v0.4.0 to v0.5.0:
-  .
-  * Changed order of @MidiVoiceEvent@ constructors so the Ord 
-    instance follows the order of the /tag/ in the MIDI binary
-    representation.
-  . 
-  * Changed @MidiSysCommonEvent@ to have different constructors 
-    for unidentified F4 anf F5 events.   
-  .
-  * Changed @MidiSysRealTimeEvent@ to have different constructors
-    for unidentified F9 and FD events.  
-  . 
-  * Added more Haddock docs.
-  .
-  * Various internal code changes.
-  .
-  v0.3.0 to v0.4.0:
-  .
-  * Added new constructors to @MidiMetaEvent@ for MidiPort and 
-    MetaOther. MetaOther recognizes otherwise unrecognized events
-    improving the robustness of the parser. Similarly a new 
-    /other/ constructor has been added to @MidiScaleType@ to 
-    avoid parse errors.
-  .
-  v0.2.1 to v0.3.0:
-  .
-  * Revised naming of the MIDI data types. All data types now have 
-    the prefix Midi (previously only MidiFile followed this scheme).
-    The rationale for this is client software, that might want a 
-    higher-level representation, is then free to use the more 
-    generic names Track, Message, etc.
-  .
-  * @DeltaTime@ made a newtype wrapper rather than a type synonym.
-  .
-  * Renamed the pretty print functions @track@ to @printMidiTrack@ 
-    and @header@ to @printMidiHeader@.
-  .
-  * Moved internal dataypes (SplitByte, Varlen) into a private 
-    module.
-  .
-  v0.2.0 to v0.2.1:
-  . 
-  * Added Show class constraints to various type signatures to 
-    accommodate changes to Num superclass hierarchy in GHC 7.4.
-    Thanks to Remy Moueza for the patches.
-  . 
-  v0.1.0 to v0.2.0:
-  .
-  * Added a top-level /shim/ module to import all the exposed
-    modules. Added a version number module
-  .
+  For older changes see - CHANGES file.
   .
 build-type:         Simple
 stability:          unstable
@@ -96,6 +65,7 @@
   hs-source-dirs:     src
   build-depends:      base < 5,
                       bytestring,
+                      containers,
                       binary >= 0.5
   
   exposed-modules:
@@ -103,6 +73,10 @@
     ZMidi.Core.Canonical,
     ZMidi.Core.Datatypes,
     ZMidi.Core.Pretty,
+    ZMidi.Core.Pretty.Ascii,
+    ZMidi.Core.Pretty.Csv,
+    ZMidi.Core.Pretty.Internal,
+    ZMidi.Core.Pretty.Interp,
     ZMidi.Core.ReadFile,
     ZMidi.Core.VersionNumber,
     ZMidi.Core.WriteFile
