diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,26 @@ + 0.8.2 to 0.9.0: + + * Improvements to handling pitch bend. The value of pitch + bend is now represented as a Word14 and it is encoded + and decoded according to the MIDI spec (previously it + was left uninterpreted). + Thanks to Joachim Tilsted Kristensen. + + * Removed ZMidi.Core.VersionNumber file. This means we can + have a vanilla Setup.hs file. + +0.8.1 to 0.8.2: + + * Updated to compile with ghc-8.4. Thanks to Evan Laforge. + +0.8.0 to 0.8.1: + + * Fixed error with missing CPP directive in ZMidi.Core.Pretty. + + +0.7.0 to 0.8.0: + + * Updated to compile without errors with GHC 7.10. 0.6.0 to 0.7.0: diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,29 +1,2 @@ -#!/usr/bin/env runhaskell - import Distribution.Simple -import Distribution.Simple.Setup ( SDistFlags ) -import Distribution.PackageDescription ( HookedBuildInfo, emptyHookedBuildInfo ) - - -main = defaultMainWithHooks sdist_warning_hooks - -sdist_warning_hooks :: UserHooks -sdist_warning_hooks = simpleUserHooks { preSDist = sdistVersionWarning } - - -sdistVersionWarning :: Args -> SDistFlags -> IO HookedBuildInfo -sdistVersionWarning _ _ = - mapM_ putStrLn msg >> printVersionNumberFile >> return emptyHookedBuildInfo - where - msg = [ "-------------------------------------------------------" - , "-------------------------------------------------------" - , "" - , "WARNING - is ZMidi.Core.VersionNumber correct?" - , "" - , "-------------------------------------------------------" - , "-------------------------------------------------------" - ] - -printVersionNumberFile :: IO () -printVersionNumberFile = - readFile "src/ZMidi/Core/VersionNumber.hs" >>= putStrLn +main = defaultMain 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-2013 +-- Copyright : (c) Stephen Tetley 2010-2018 -- License : BSD3 -- -- Maintainer : Stephen Tetley @@ -28,7 +28,6 @@ , module ZMidi.Core.Pretty.Ascii , module ZMidi.Core.Pretty.Csv , module ZMidi.Core.ReadFile - , module ZMidi.Core.VersionNumber , module ZMidi.Core.WriteFile ) where @@ -39,5 +38,4 @@ 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/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-2013 +-- Copyright : (c) Stephen Tetley 2010-2018 -- License : BSD3 -- -- Maintainer : Stephen Tetley @@ -26,8 +26,11 @@ module ZMidi.Core.Datatypes ( + + -- * A word14 type (for pitch bends) + Word14 -- * MidiFile syntax. - DeltaTime + , DeltaTime , TagByte , MidiFile(..) @@ -51,11 +54,51 @@ ) where +import Data.Bits import Data.Int import Data.Word +------------------------------------------------------------------------------- +-- Word14 +------------------------------------------------------------------------------- +-- | Midi represents pitch bend values as Word14 value +-- (range 0 to 16383). +-- +-- It seems useful to make a distinction between this type +-- and Word16, even though it implemented as a Word16 under +-- the hood. +-- +newtype Word14 = Word14 { getWord14 :: Word16 } + deriving (Enum,Eq,Ord,Integral,Real,Bits) +-- | For addition, but especially multiplication, operate +-- on integers rather than the underlying Word16 the we don't +-- get "eager" modulo operations. +makeWord14 :: Integer -> Word14 +makeWord14 i = Word14 $ fromInteger $ i `mod` 16384 + +extractWord14 :: Word14 -> Integer +extractWord14 = fromIntegral . getWord14 + +instance Bounded Word14 where + minBound = 0 + maxBound = 16383 + +instance Num Word14 where + a + b = makeWord14 $ extractWord14 a + extractWord14 b + a - b = makeWord14 $ extractWord14 a - extractWord14 b + a * b = makeWord14 $ extractWord14 a * extractWord14 b + abs a = Word14 $ abs (getWord14 a) + negate a = makeWord14 $ negate (extractWord14 a) + signum a = Word14 $ signum (getWord14 a) + fromInteger = makeWord14 + + +instance Show Word14 where + showsPrec p = showsPrec p . getWord14 + + -- | All time values in a MIDI track are represented as a \delta\ -- from the previous event rather than an absolute time. -- @@ -302,9 +345,10 @@ -- Change the pitch of a sounding note. Often used to -- approximate microtonal tunings. -- - -- NOTE - currently value is uninterpreted. + -- NOTE - as of v0.9.0 the value is interpreted. + -- This is a Word14 value, the range is (0..16383). -- - | PitchBend Word8 Word16 + | PitchBend Word8 Word14 deriving (Eq,Ord,Show) 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-2013 +-- Copyright : (c) Stephen Tetley 2010-2018 -- License : BSD3 -- -- Maintainer : Stephen Tetley @@ -58,8 +58,11 @@ joinByte (SB a b) = (a .&. 0xF0) + (b .&. 0x0F) + + + -------------------------------------------------------------------------------- --- helper for varlen +-- Helper for varlen -------------------------------------------------------------------------------- -- | Space efficient representation of length fields. 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 @@ -1,9 +1,10 @@ +{-# LANGUAGE CPP #-} {-# OPTIONS -Wall #-} -------------------------------------------------------------------------------- -- | -- Module : ZMidi.Core.Internal.ParseMonad --- Copyright : (c) Stephen Tetley 2010-2013 +-- Copyright : (c) Stephen Tetley 2010-2015 -- License : BSD3 -- -- Maintainer : Stephen Tetley @@ -53,7 +54,9 @@ ) where +#ifndef MIN_VERSION_GLASGOW_HASKELL import Control.Applicative +#endif import Data.Bits import qualified Data.ByteString.Lazy as L import Data.Char @@ -333,7 +336,7 @@ + (shiftL `flip` 8 $ fromIntegral b) + fromIntegral c --- | Build a Word16 (big endian). +-- | Build a Word32 (big endian). -- w32be :: Word8 -> Word8 -> Word8 -> Word8 -> Word32 w32be a b c d = (shiftL `flip` 24 $ fromIntegral a) 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 @@ -1,9 +1,10 @@ +{-# LANGUAGE CPP #-} {-# OPTIONS -Wall #-} -------------------------------------------------------------------------------- -- | -- Module : ZMidi.Core.Internal.SimpleFormat --- Copyright : (c) Stephen Tetley 2010-2013 +-- Copyright : (c) Stephen Tetley 2010-2015 -- License : BSD3 -- -- Maintainer : Stephen Tetley @@ -54,8 +55,12 @@ +#ifndef MIN_VERSION_GLASGOW_HASKELL import Control.Applicative +#endif +#ifndef MIN_VERSION_GLASGOW_HASKELL import Data.Monoid +#endif import Data.Word import Numeric @@ -285,6 +290,10 @@ mempty = WString 0 id WString w1 f1 `mappend` WString w2 f2 = WString (w1+w2) (f1 . f2) +#if MIN_VERSION_base(4,11,0) +instance Semigroup WString where + (<>) = mappend +#endif infixr 6 <+> @@ -353,4 +362,4 @@ -- | Show an Integral value as a base 10 number. -- integral :: (Show a, Integral a) => a -> WString -integral = wstring . show +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 @@ -1,3 +1,4 @@ + {-# LANGUAGE CPP #-} {-# OPTIONS -Wall #-} -------------------------------------------------------------------------------- @@ -36,7 +37,9 @@ import ZMidi.Core.Pretty.Internal import ZMidi.Core.Pretty.Interp +#ifndef MIN_VERSION_GLASGOW_HASKELL import Data.Monoid +#endif -- | Print the MIDI file to stdout. -- @@ -236,7 +239,7 @@ 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 +valVoiceEvent (PitchBend c v) = hex2 c <+> hex4 (fromIntegral v) -- | Get formatted value. diff --git a/src/ZMidi/Core/Pretty/Ascii.hs b/src/ZMidi/Core/Pretty/Ascii.hs --- a/src/ZMidi/Core/Pretty/Ascii.hs +++ b/src/ZMidi/Core/Pretty/Ascii.hs @@ -1,9 +1,10 @@ +{-# LANGUAGE CPP #-} {-# OPTIONS -Wall #-} -------------------------------------------------------------------------------- -- | -- Module : ZMidi.Core.Pretty.Ascii --- Copyright : (c) Stephen Tetley 2013 +-- Copyright : (c) Stephen Tetley 2013-2015 -- License : BSD3 -- -- Maintainer : Stephen Tetley @@ -29,7 +30,9 @@ import ZMidi.Core.Pretty.Internal import ZMidi.Core.Pretty.Interp +#ifndef MIN_VERSION_GLASGOW_HASKELL import Data.Monoid +#endif import Data.Word diff --git a/src/ZMidi/Core/Pretty/Csv.hs b/src/ZMidi/Core/Pretty/Csv.hs --- a/src/ZMidi/Core/Pretty/Csv.hs +++ b/src/ZMidi/Core/Pretty/Csv.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# OPTIONS -Wall #-} -------------------------------------------------------------------------------- @@ -28,7 +29,9 @@ import ZMidi.Core.Pretty.Internal +#if !MIN_VERSION_base(4,8,0) import Data.Monoid +#endif -- | Print the MIDI file to stdout (CSV format). diff --git a/src/ZMidi/Core/Pretty/Internal.hs b/src/ZMidi/Core/Pretty/Internal.hs --- a/src/ZMidi/Core/Pretty/Internal.hs +++ b/src/ZMidi/Core/Pretty/Internal.hs @@ -1,9 +1,10 @@ +{-# LANGUAGE CPP #-} {-# OPTIONS -Wall #-} -------------------------------------------------------------------------------- -- | -- Module : ZMidi.Core.Pretty.Internal --- Copyright : (c) Stephen Tetley 2013 +-- Copyright : (c) Stephen Tetley 2015 -- License : BSD3 -- -- Maintainer : Stephen Tetley @@ -36,7 +37,9 @@ import Data.Char +#ifndef MIN_VERSION_GLASGOW_HASKELL import Data.Monoid +#endif import Data.Word -- | Column specs for Header - Header is printed as simple 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 @@ -1,9 +1,10 @@ +{-# LANGUAGE CPP #-} {-# OPTIONS -Wall #-} -------------------------------------------------------------------------------- -- | -- Module : ZMidi.Core.ReadFile --- Copyright : (c) Stephen Tetley 2010-2013 +-- Copyright : (c) Stephen Tetley 2010-2018 -- License : BSD3 -- -- Maintainer : Stephen Tetley @@ -44,7 +45,9 @@ import ZMidi.Core.Internal.ParserMonad +#ifndef MIN_VERSION_GLASGOW_HASKELL import Control.Applicative +#endif import Control.Monad import Data.Bits import qualified Data.ByteString.Lazy as L @@ -107,7 +110,7 @@ event = peek >>= step where -- 00..7f -- /data/ - step n + step n | n == 0xFF = MetaEvent <$> (dropW8 *> (word8 >>= metaEvent)) | n >= 0xF8 = SysRealTimeEvent <$> (dropW8 *> sysRealTimeEvent n) | n == 0xF7 = SysExEvent <$> (dropW8 *> sysExEscape) @@ -142,7 +145,7 @@ voiceEvent (SB 0xD0 ch) = setRunningEvent (RS_CHAN_AFT ch) >> chanAftertouch ch -voiceEvent (SB 0xE0 ch) = +voiceEvent (SB 0xE0 ch) = setRunningEvent (RS_PCH_BEND ch) >> pitchBend ch -- This is an /impossible/ match - to get here either @splitByte@ @@ -177,7 +180,7 @@ pitchBend :: Word8 -> ParserM MidiVoiceEvent pitchBend ch = - "pitch bend" (PitchBend ch) <$> word16be + "pitch bend" (PitchBend ch) <$> word14be @@ -258,60 +261,60 @@ sysExEscape :: ParserM MidiSysExEvent sysExEscape = "sys-ex" getVarlenBytes SysExEscape --- | 0xFF and the "type" byte already parsed, input to this +-- | 0xFF and the "type" byte already parsed, input to this -- function is the type byte. -- --- Not all MetaEvents are enumerated - unrecognized ones are +-- Not all MetaEvents are enumerated - unrecognized ones are -- delegated to @MetaOther@. -- metaEvent :: Word8 -> ParserM MidiMetaEvent -metaEvent 0x00 = +metaEvent 0x00 = "sequence number" SequenceNumber <$> (assertWord8 2 *> word16be) -metaEvent 0x01 = "generic text" textEvent GENERIC_TEXT -metaEvent 0x02 = "copyrightn notice" textEvent COPYRIGHT_NOTICE +metaEvent 0x01 = "generic text" textEvent GENERIC_TEXT +metaEvent 0x02 = "copyright notice" textEvent COPYRIGHT_NOTICE metaEvent 0x03 = "sequence name" textEvent SEQUENCE_NAME metaEvent 0x04 = "instrument name" textEvent INSTRUMENT_NAME metaEvent 0x05 = "lyrics" textEvent LYRICS metaEvent 0x06 = "marker" textEvent MARKER metaEvent 0x07 = "cue point" textEvent CUE_POINT -metaEvent 0x20 = +metaEvent 0x20 = "channel prefix" ChannelPrefix <$> (assertWord8 0x01 *> word8) -metaEvent 0x21 = +metaEvent 0x21 = "MIDI port" MidiPort <$> (assertWord8 0x01 *> word8) -metaEvent 0x2F = - "end of track" EndOfTrack <$ assertWord8 0 +metaEvent 0x2F = + "end of track" EndOfTrack <$ assertWord8 0 -metaEvent 0x51 = +metaEvent 0x51 = "set tempo" SetTempo <$> (assertWord8 3 *> word24be) -metaEvent 0x54 = - "smpte offset" SMPTEOffset <$> (assertWord8 5 *> word8) +metaEvent 0x54 = + "smpte offset" SMPTEOffset <$> (assertWord8 5 *> word8) <*> word8 <*> word8 <*> word8 <*> word8 -metaEvent 0x58 = +metaEvent 0x58 = "time signature" TimeSignature <$> (assertWord8 4 *> word8) - <*> word8 <*> word8 - <*> word8 + <*> word8 <*> word8 + <*> word8 -metaEvent 0x59 = - "key signature" KeySignature <$> (assertWord8 2 *> int8) +metaEvent 0x59 = + "key signature" KeySignature <$> (assertWord8 2 *> int8) <*> scale -metaEvent 0x7F = +metaEvent 0x7F = "system specific meta event" getVarlenBytes SSME -metaEvent ty = +metaEvent ty = "meta other" getVarlenBytes (MetaOther ty) - + fileFormat :: ParserM MidiFormat fileFormat = word16be >>= fn where @@ -340,6 +343,16 @@ -------------------------------------------------------------------------------- -- helpers + +word14be :: ParserM Word14 +word14be = (\lsb msb -> toWord14BE (lsb,msb)) <$> word8 <*> word8 + + +toWord14BE :: (Word8,Word8) -> Word14 +toWord14BE (lsb,msb) = msb' .|. lsb' + where + lsb' = fromIntegral lsb + msb' = (fromIntegral msb) `shiftL` 7 impossibleMatch :: String -> ParserM a diff --git a/src/ZMidi/Core/VersionNumber.hs b/src/ZMidi/Core/VersionNumber.hs deleted file mode 100644 --- a/src/ZMidi/Core/VersionNumber.hs +++ /dev/null @@ -1,28 +0,0 @@ -{-# OPTIONS -Wall #-} - --------------------------------------------------------------------------------- --- | --- Module : ZMidi.Core.VersionNumber --- Copyright : (c) Stephen Tetley 2010-2013 --- License : BSD3 --- --- Maintainer : stephen.tetley@gmail.com --- Stability : unstable --- Portability : GHC --- --- Version number --- --------------------------------------------------------------------------------- - -module ZMidi.Core.VersionNumber - ( - zmidi_core_version - - ) where - --- | Version number --- --- > (0,7,0) --- -zmidi_core_version :: (Int,Int,Int) -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 @@ -1,9 +1,10 @@ +{-# LANGUAGE CPP #-} {-# OPTIONS -Wall #-} -------------------------------------------------------------------------------- -- | -- Module : ZMidi.Core.WriteFile --- Copyright : (c) Stephen Tetley 2010-2013 +-- Copyright : (c) Stephen Tetley 2010-2018 -- License : BSD3 -- -- Maintainer : Stephen Tetley @@ -25,7 +26,9 @@ import Data.Binary.Put -- package: binary +#ifndef MIN_VERSION_GLASGOW_HASKELL import Control.Applicative +#endif import Data.Bits import qualified Data.ByteString.Lazy as L import Data.Char (ord) @@ -114,7 +117,8 @@ optTagByte rs (0xD `u4l4` c) *> putWord8 v putVoiceEvent rs (PitchBend c v) = - optTagByte rs (0xE `u4l4` c) *> putWord16be v + let (lsb,msb) = fromWord14BE v in + optTagByte rs (0xE `u4l4` c) *> putWord8 lsb *> putWord8 msb -- Note - F7 (terminator) should be the last byte in the @@ -228,6 +232,16 @@ -------------------------------------------------------------------------------- -- Output helpers + + +-- | Helper for Pitch Bend, min is 0, max is 16383 +-- (lsb, msb) +fromWord14BE :: Word14 -> (Word8,Word8) +fromWord14BE a = (lsb,msb) + where + lsb = fromIntegral (a .&. 0x007f) + msb = (.&. 0x7f) $ fromIntegral (a `shiftR` 7) + optTagByte :: MidiRunningStatus -> Word8 -> PutM () optTagByte RS_OFF n = putWord8 n diff --git a/zmidi-core.cabal b/zmidi-core.cabal --- a/zmidi-core.cabal +++ b/zmidi-core.cabal @@ -1,10 +1,10 @@ name: zmidi-core -version: 0.7.0 +version: 0.9.0 license: BSD3 license-file: LICENSE copyright: Stephen Tetley maintainer: Stephen Tetley -homepage: http://code.google.com/p/copperbox/ +homepage: https://github.com/stephentetley/zmidi-core category: Music synopsis: Read and write MIDI files. description: @@ -14,40 +14,25 @@ . 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). + v0.8.2 to v0.9.0: . - * Added @SysExCont@ and @SysExEscape@ constructors to the - @MidiSysExEvent@ data type. + * Improvements to handling pitch bend. The value of pitch + bend is now represented as a Word14 and it is encoded + and decoded according to the MIDI spec (previously it + was left uninterpreted). + Thanks to Joachim Tilsted Kristensen. . - * 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. + * Removed ZMidi.Core.VersionNumber file. This means we can + have a vanilla Setup.hs file. . - * @printMidiHeader@ and @printMidiTrack@ from @Pretty@ changed - to MidiFiles as arguments, @printMidi@ has now become - @putMidi@. + v0.8.1 to v0.8.2: . - v0.5.0 to v0.6.0: + * Updated to compile with ghc-8.4. Thanks to Evan Laforge. . - * Extended the parser and changed the syntax tree to interpret - MIDI Running Status. + v0.8.0 to v0.8.1: . - * Added a module @ZMidi.Core.Canonical@ to translate MidiFiles - to a canonical form where any shorthand NoteOff introduced by - Running Status is expanded to regular NoteOn and NoteOff - events (with Running Status set, MidiFiles can signal NoteOff - events as another NoteOn with 0 channel velocity). - . - * Added a hack to the pretty printer to stop printing ASCII - chars greater than 164 causing an error when printing to - stdout. - . + * Fixed error with missing CPP directive in ZMidi.Core.Pretty. + . For older changes see - CHANGES file. . build-type: Simple @@ -78,7 +63,6 @@ ZMidi.Core.Pretty.Internal, ZMidi.Core.Pretty.Interp, ZMidi.Core.ReadFile, - ZMidi.Core.VersionNumber, ZMidi.Core.WriteFile other-modules: