diff --git a/midi-music-box.cabal b/midi-music-box.cabal
--- a/midi-music-box.cabal
+++ b/midi-music-box.cabal
@@ -1,5 +1,5 @@
 Name:                midi-music-box
-Version:             0.0.0.5
+Version:             0.0.1
 Synopsis:            Convert MIDI file to music box punch tape
 Description:
   Convert MIDI file to music box punch tape for this kind of music box:
@@ -47,7 +47,10 @@
   If the song has key Y minor, then X=Y+3.
   .
   You find executables for MS Windows in two ZIP archives there:
-  <http://code.haskell.org/~thielema/midi-music-box/>
+  .
+  * <http://code.henning-thielemann.de/midi-music-box/midi-music-box.zip>
+  .
+  * <http://code.henning-thielemann.de/midi-music-box/midi-music-box-dll.zip>
 Homepage:            http://hub.darcs.net/thielema/midi-music-box
 License:             BSD3
 License-File:        LICENSE
@@ -58,7 +61,7 @@
 Cabal-Version:       >=1.10
 
 Source-Repository this
-  Tag:         0.0.0.5
+  Tag:         0.0.1
   Type:        darcs
   Location:    http://hub.darcs.net/thielema/midi-music-box
 
@@ -67,17 +70,18 @@
   Location:    http://hub.darcs.net/thielema/midi-music-box
 
 Executable midi-music-box
-  Main-Is:             Main.hs
-  Hs-Source-Dirs:      src
   Default-Language:    Haskell2010
   GHC-Options:         -Wall
   Build-Depends:
     diagrams-postscript >=1.3 && <1.5,
     diagrams-lib >=1.3 && <1.5,
-    midi >=0.2.1 && <0.3,
+    midi >=0.2.2 && <0.3,
     event-list >=0.1.1 && <0.2,
     optparse-applicative >=0.11 && <0.15,
     containers >=0.4 && <0.7,
-    non-empty >=0.1.3 && <0.4,
     utility-ht >=0.0.10 && <0.1,
     base >=4.5 && <5
+  Hs-Source-Dirs:      src
+  Main-Is:             Main.hs
+  Other-Modules:
+    Note
diff --git a/src/Main.hs b/src/Main.hs
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,10 +1,11 @@
 {-# LANGUAGE FlexibleContexts #-}
 module Main where
 
+import qualified Note
+
 import qualified Sound.MIDI.Message.Class.Query as Query
 
 import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
-import qualified Sound.MIDI.File.Event as FileEvent
 import qualified Sound.MIDI.File.Load as Load
 import qualified Sound.MIDI.File as MidiFile
 
@@ -13,17 +14,25 @@
 
 import qualified Diagrams.Backend.Postscript.CmdLine as PS
 import qualified Diagrams.Backend.CmdLine as Cmd
-import Diagrams.Prelude
+import Diagrams.Prelude (Diagram)
+import Diagrams.Prelude (translateX, translateY, translate, r2, alignTL)
+import Diagrams.Prelude (hsep, vsep)
+import Diagrams.Prelude (circle, rect, hrule, vrule)
+import Diagrams.Prelude (lwO, text, fontSizeL)
+import Diagrams.Prelude (fc, lc, yellow, blue, darkgreen, white, grey, black)
+import Diagrams.Prelude ((#), (<$>), (<>))
 
 import qualified Options.Applicative as OP
 
 import qualified System.IO as IO
-import Text.Printf (hPrintf, )
+import Text.Printf (hPrintf, printf)
 
 import Control.Monad (when, )
 
 import qualified Data.Map as Map; import Data.Map (Map, )
-import qualified Data.NonEmpty as NonEmpty
+import qualified Data.List.HT as ListHT
+import qualified Data.List as List
+import qualified Data.Monoid.HT as MnHT
 import qualified Data.Monoid as Mn
 import Data.Foldable (foldMap, fold, )
 import Data.Tuple.HT (mapSnd, )
@@ -31,9 +40,6 @@
 
 type Diag = Diagram PS.B
 
-numLong :: Int
-numLong = 15
-
 globalScale :: Double
 globalScale = 1/7
 
@@ -41,10 +47,6 @@
 horsep = 40*globalScale
 versep = 80*globalScale
 
-hormargin, horextramargin :: Double
-hormargin = 65*globalScale
-horextramargin = 100*globalScale
-
 horlen, verlen :: Int -> Double
 horlen n = fromIntegral n * horsep
 verlen n = fromIntegral n * versep
@@ -54,74 +56,110 @@
 thickLW = lwO (8*globalScale)
 
 
-labels :: Diag
-labels =
-   hcat' (with & sep .~ horsep) $
-   map (\str -> text str # fontSizeL horsep) $
-   map (:[]) "CDEFGABCDEFGABC"
+data MusicScale =
+   MusicScale {
+      scaleLabels :: [Char],
+      greenLines :: [Bool],
+      scaleNoteMap :: Map Int (Bool, Int),
+      horizontalMargin, horizontalExtraMargin :: Double
+   }
 
-long :: Int -> Diag
-long numIntervals =
-   hcat' (with & sep .~ horsep) $
+musicScale15, musicScale30 :: MusicScale
+musicScale15 =
+   musicScaleFromNotes Note.pitches15 (65*globalScale, 100*globalScale)
+musicScale30 =
+   musicScaleFromNotes Note.pitches30 (3*horsep, 5*horsep)
+
+musicScaleFromNotes :: [(Bool, (Char, Int))] -> (Double,Double) -> MusicScale
+musicScaleFromNotes notes (hormargin, horextramargin) =
+   let (greenLines_, (scaleLabels_,ps)) = mapSnd unzip $ unzip notes
+   in MusicScale {
+         horizontalMargin = hormargin,
+         horizontalExtraMargin = horextramargin,
+         scaleLabels = scaleLabels_,
+         greenLines = greenLines_,
+         scaleNoteMap =
+            Map.fromList $ concat $
+            zipWith3
+               (\pos p k ->
+                  take k $ zip [p..] $ (True,pos) : repeat (False,pos))
+               [0..] ps (ListHT.mapAdjacent subtract ps ++ [1])
+      }
+
+
+labels :: [Char] -> Diag
+labels = hsep horsep . map (\char -> text [char] # fontSizeL horsep)
+
+long :: [Bool] -> Int -> Diag
+long greenLs numIntervals =
+   hsep horsep $
    map (\(wid, col) ->
           vrule (verlen numIntervals) # wid # lc col) $
-      let l = (normalLW, black); h = (thickLW, darkgreen)
-      in  [l, l, h, l, h, l, h, l, h, l, h, l, l, l, l]
+   map
+      (\isGreen -> if isGreen then (thickLW, darkgreen) else (normalLW, black))
+      greenLs
 
-across :: Int -> Diag
-across numIntervals =
-   vcat' (with & sep .~ versep) $
+across :: Int -> Int -> Diag
+across numLong numIntervals =
+   vsep versep $
    take (succ numIntervals) $ cycle $
       let len = horlen (numLong-1)
       in  map (# normalLW) [hrule len, hrule len # lc grey]
 
-grid :: Int -> Diag
-grid numIntervals =
-   alignTL (long numIntervals) <>
-   alignTL (across numIntervals) <>
+grid :: MusicScale -> Cutter -> Int -> Diag
+grid musicScale (Cutter cutter) numIntervals =
+  let numLong = length $ scaleLabels musicScale
+      hormargin = horizontalMargin musicScale
+      horextramargin = horizontalExtraMargin musicScale
+  in
+   MnHT.when (not cutter)
+      (alignTL (long (greenLines musicScale) numIntervals)) <>
+   MnHT.when (not cutter) (alignTL (across numLong numIntervals)) <>
    translateX (-hormargin)
       (alignTL (vrule (verlen numIntervals) # normalLW # lc grey)) <>
    translateX (horlen (numLong-1) + hormargin)
       (alignTL (vrule (verlen numIntervals) # normalLW # lc grey)) <>
-   translateY (0.5*versep) labels <>
+   MnHT.when (not cutter)
+      (translateY (0.5*versep) $ labels $ scaleLabels musicScale) <>
    (translateX (-horextramargin) $ translateY (verlen 2) $ alignTL $ lc white $
     rect (horlen (numLong-1) + 2*horextramargin) (verlen (numIntervals+4)))
 
 
-dots :: [(DotType, (Int, Double))] -> Diag
-dots poss =
+dots :: Diameter -> Cutter -> [(DotType, (Int, Double))] -> Diag
+dots (Diameter diameterRel) (Cutter cutter) poss =
    flip foldMap poss $
    \(typ, (x,y)) ->
       translate (r2 (horlen x, - versep * y)) $
-      let warning txt =
+      let radius = horsep*diameterRel/2
+          warning txt =
             (fontSizeL horsep $ text txt) <>
             (lwO 0 $ fc yellow $ circle (horsep*0.4))
-      in  case typ of
-            Valid -> normalLW $ fc blue $ circle (horsep*0.25)
-            Semitone -> warning "#"
-            TooLow -> warning "!"
-            TooHigh -> warning "!"
-
-noteMap :: Map Int (Bool, Int)
-noteMap =
-   let o = True; x = False
-       semitones = cycle [o,x,o,x,o,o,x,o,x,o,x,o]
-   in  Map.fromList $ take 25 $ zip [0..] $ zip semitones $
-       NonEmpty.tail $ NonEmpty.scanl (+) (-1) $ map fromEnum semitones
+      in if cutter
+            then
+               case typ of
+                  Valid -> normalLW $ circle radius
+                  _ -> Mn.mempty
+            else
+               case typ of
+                  Valid -> normalLW $ fc blue $ circle radius
+                  Semitone -> warning "#"
+                  TooLow -> warning "!"
+                  TooHigh -> warning "!"
 
 
 data DotType = Valid | Semitone | TooLow | TooHigh
    deriving (Eq, Ord)
 
 layoutDots ::
+   Map Int (Bool, Int) ->
    TimeStep -> VoiceMsg.Pitch -> MidiFile.T -> [(DotType, (Int, Double))]
-layoutDots (TimeStep timeStep) zeroKey (MidiFile.Cons typ division tracks) =
+layoutDots
+      noteMap (TimeStep timeStep) zeroKey (MidiFile.Cons typ division tracks) =
    map (\(t, (dottyp,p)) -> (dottyp, (p,t))) $
    AbsEventList.toPairList $
    AbsEventList.mapTime ((/timeStep) . realToFrac) $
    AbsEventList.mapMaybe
-      (\fev -> do
-         FileEvent.MIDIEvent ev <- Just fev
+      (\ev -> do
          (_c, (_v, p, True)) <- Query.noteExplicitOff ev
          let pz = VoiceMsg.subtractPitch zeroKey p
          return $
@@ -138,6 +176,29 @@
    map (MidiFile.secondsFromTicks division) tracks
 
 
+musicScaleMap :: Map String MusicScale
+musicScaleMap =
+   Map.fromList $
+      ("major15", musicScale15) :
+      ("mixed30", musicScale30) :
+      []
+
+instance Cmd.Parseable MusicScale where
+   parser =
+      OP.option
+         (OP.eitherReader $ \str ->
+            maybe
+               (Left $
+                printf "unknown name '%s', must be one of %s" str
+                  (List.intercalate ", " $ Map.keys musicScaleMap))
+               Right $
+            Map.lookup str musicScaleMap)
+         (OP.long "music-scale" Mn.<>
+          OP.metavar "NAME" Mn.<>
+          OP.value musicScale15 Mn.<>
+          OP.help "Type of music box")
+
+
 newtype ZeroKey = ZeroKey Int
 
 instance Cmd.Parseable ZeroKey where
@@ -160,16 +221,40 @@
           OP.help "time step between lines")
 
 
+newtype Cutter = Cutter Bool
+
+instance Cmd.Parseable Cutter where
+   parser =
+      Cutter <$>
+      OP.flag False True
+         (OP.long "cutter" Mn.<>
+          OP.help "stripped graphics ready for laser cutter")
+
+
+newtype Diameter = Diameter Double
+
+instance Cmd.Parseable Diameter where
+   parser =
+      OP.option (Diameter <$> OP.auto)
+         (OP.long "hole-diameter" Mn.<>
+          OP.metavar "RATIO" Mn.<>
+          OP.value (Diameter 0.5) Mn.<>
+          OP.help "size of a hole relative to line distance")
+
+
 newtype Input = Input FilePath
 
 instance Cmd.Parseable Input where
    parser = OP.argument (Input <$> OP.str) (OP.metavar "INPUT")
 
 
-diag :: TimeStep -> ZeroKey -> Input -> IO Diag
-diag timeStep (ZeroKey zeroKey) (Input path) = do
+diag ::
+   MusicScale -> TimeStep -> ZeroKey -> Diameter -> Cutter -> Input -> IO Diag
+diag musicScale timeStep (ZeroKey zeroKey) diameter cutter (Input path) = do
    midi <- Load.fromFile path
-   let cloud = layoutDots timeStep (VoiceMsg.toPitch zeroKey) midi
+   let cloud =
+         layoutDots (scaleNoteMap musicScale)
+            timeStep (VoiceMsg.toPitch zeroKey) midi
        sorted = Map.fromListWith (++) $ map (mapSnd (:[])) cloud
        warning typ msg =
          let n = length $ fold $ Map.lookup typ sorted
@@ -177,7 +262,9 @@
    warning Semitone "semitones"
    warning TooLow "notes are too low"
    warning TooHigh "notes are too high"
-   return $ dots cloud <> (grid $ ceiling $ maximum $ map (snd . snd) cloud)
+   return $
+      dots diameter cutter cloud <>
+      (grid musicScale cutter $ ceiling $ maximum $ map (snd . snd) cloud)
 
 main :: IO ()
 main = PS.mainWith diag
diff --git a/src/Note.hs b/src/Note.hs
new file mode 100644
--- /dev/null
+++ b/src/Note.hs
@@ -0,0 +1,39 @@
+module Note where
+
+pitch :: Char -> Int -> Int -> (Char, Int)
+pitch char nt oct = (char, nt+oct*12)
+
+c,d,e,f,g,a,b :: Int -> (Char, Int)
+c = pitch 'C'  0
+d = pitch 'D'  2
+e = pitch 'E'  4
+f = pitch 'F'  5
+g = pitch 'G'  7
+a = pitch 'A'  9
+b = pitch 'B' 11
+
+(#) :: (a -> (Char, Int)) -> a -> (Char, Int)
+noteFunc # oct = ('#', succ $ snd $ noteFunc oct)
+
+
+infixr 5 .:, |:
+
+(.:), (|:) :: a -> [(Bool, a)] -> [(Bool, a)]
+x .: xs  = (False,x) : xs
+x |: xs  = (True, x) : xs
+
+
+pitches15, pitches30 :: [(Bool, (Char, Int))]
+pitches15 =
+   c 0 .: d 0 .: e 0 |: f 0 .: g 0 |: a 0 .: b 0 |:
+   c 1 .: d 1 |: e 1 .: f 1 |: g 1 .: a 1 .: b 1 .:
+   c 2 .: []
+
+pitches30 =
+   c 0 .: d 0 .: g 0 .: a 0 .: b 0 .:
+   c 1 .: d 1 .: e 1 |:
+   f 1 .: f#1 .: g 1 |: g#1 .: a 1 .: a#1 .: b 1 |:
+   c 2 .: c#2 .: d 2 |: d#2 .: e 2 .:
+   f 2 |: f#2 .: g 2 .: g#2 .: a 2 .: a#2 .: b 2 .:
+   c 3 .: d 3 .: e 3 .:
+   []