module Midi (tofile,DeltaTime,
             Event(NoteOff,NoteOn,PitchBend,MetaEvent,ProgramChange,ControllerChange),
             MetaEvent(EndOfTrack,TimeSignature),
             Channel,Note,Velocity,Bend,Program,Controller,Value) where

import Data.Char

type Channel = Int
type Note = Int
type Velocity = Int
type Bend = Int
type Program = Int
type Controller = Int
type Value = Int

data Event = NoteOff Channel Note Velocity
           | NoteOn Channel Note Velocity
           | PitchBend Channel Bend
           | ProgramChange Channel Program
           | ControllerChange Channel Controller Value
           | MetaEvent MetaEvent
             deriving (Eq,Show)

data MetaEvent = EndOfTrack
               | TimeSignature Int Int -- the meter: a/2^b
               deriving (Eq,Show)
type DeltaTime = Int

byte value = chr value

unsigned32 value =
    [byte (value `div` 256 `div` 256 `div` 256 `mod` 256),
     byte (value `div` 256 `div` 256 `mod` 256),
     byte (value `div` 256 `mod` 256),
     byte (value `mod` 256)]


unsigned16 value =
    [byte (value `div` 256 `mod` 256),
     byte (value `mod` 256)]

variablelength value =
    if value < 128 then [byte value]
    else variablelength' (value `div` 128) ++ [byte (value `mod` 128)]
    where variablelength' value =
              if value == 0 then []
              else variablelength' (value `div` 128)
                       ++ [byte (128 + (value `mod` 128))]

chunk name contents =
    if length name /= 4 then error "chunk name must be 4 characters long"
    else name ++ unsigned32 (length contents) ++ contents

header numdivisionsperquarternote
    = chunk "MThd" (unsigned16 format
                       ++ unsigned16 numchannels
                       ++ unsigned16 numdivisionsperquarternote)
    where format = if numchannels == 1 then 0 else 1
          numchannels = 1

track::[(DeltaTime,Event)]->String
track trackevents =
    if null trackevents || snd (last trackevents) /= MetaEvent EndOfTrack then error "a track must end with MetaEvent EndOfTrack"
    else chunk "MTrk" (concatMap trackevent trackevents)

trackevent (deltatime,evnt) =
    variablelength (deltatime) ++ event evnt

event (NoteOff chn note vel) =
    [byte (0x80 + chn), byte note, byte vel]
event (NoteOn chn note vel) =
    [byte (0x90 + chn), byte note, byte vel]
event (PitchBend chn amount) =
    [byte (0xE0 + chn), byte (amount `mod` 128), byte (amount `div` 128 `mod` 128)]
event (ProgramChange chn program) =
    [byte (0xC0 + chn), byte program]
event (ControllerChange chn controller value) =
    [byte (0xB0 + chn), byte controller, byte value]
event (MetaEvent me) =
    byte (0xFF) : metaevent me

metaevent EndOfTrack = [byte 0x2F, byte 0x00]
metaevent (TimeSignature nn dd) = [byte 0x58,
                                   byte 0x04,
                                   byte nn,
                                   byte dd,
                                   byte 24,
                                   byte 8]

tofile::DeltaTime->[(DeltaTime,Event)]->String
tofile numdivisionsperquarternote trackevents =
    header numdivisionsperquarternote ++ track trackevents