{-# OPTIONS_GHC -fno-warn-unused-binds #-}
module User.Elaforge.Instrument.Vl1Spec (
encode, decode
, vl1_header
, patch_spec
, decode_num, encode_num
) where
import qualified Data.Bits as Bits
import Data.Bits ((.|.), (.&.))
import qualified Data.ByteString as B
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as Char8
import qualified Midi.Midi as Midi
import qualified Instrument.Sysex as Sysex
import Instrument.Sysex (Specs, Spec(..), unsigned, bool, enum, ranged, signed)
vl1_header :: Int -> ByteString
Int
nbytes = [Word8] -> ByteString
B.pack
[ Word8
0xf0, Word8
Midi.yamaha_code, Word8
0, Word8
0x7a
, Word8
msb, Word8
lsb
] forall a. Semigroup a => a -> a -> a
<> ByteString
magic
where
(Word8
lsb, Word8
msb) = Int -> (Word8, Word8)
Midi.split14 (Int
nbytes forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
magic)
magic :: ByteString
magic = String -> ByteString
Char8.pack String
"LM 20117VC"
config :: Sysex.Config
config :: Config
config = (NumRange -> ByteString -> Int)
-> (NumRange -> Int -> ByteString) -> (NumRange -> Int) -> Config
Sysex.Config NumRange -> ByteString -> Int
decode_num NumRange -> Int -> ByteString
encode_num NumRange -> Int
range_bytes
decode_num :: Sysex.NumRange -> ByteString -> Int
decode_num :: NumRange -> ByteString -> Int
decode_num (Int
low, Int
high) ByteString
bytes
| Int
low forall a. Ord a => a -> a -> Bool
>= Int
0 = Int
val
| Int
high forall a. Ord a => a -> a -> Bool
<= Int
0x3f = forall a. (Integral a, Bits a) => Int -> a -> Int
Sysex.to_signed Int
7 Int
val
| Bool
otherwise = Int
val forall a. Bits a => a -> a -> a
.&. Int
0x7f forall a. Num a => a -> a -> a
- Int
val forall a. Bits a => a -> a -> a
.&. Int
0x80
where
val :: Int
val = forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' (\Int
val Word8
b -> forall a. Bits a => a -> Int -> a
Bits.shiftL Int
val Int
7 forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) Int
0 ByteString
bytes
encode_num :: Sysex.NumRange -> Int -> ByteString
encode_num :: NumRange -> Int -> ByteString
encode_num (Int
low, Int
high) Int
num
| Int
low forall a. Ord a => a -> a -> Bool
>= Int
0 = ByteString -> ByteString
B.reverse forall a b. (a -> b) -> a -> b
$ forall a. (a -> Maybe (Word8, a)) -> a -> ByteString
B.unfoldr forall {a} {b} {a}.
(Integral a, Bits a, Num b, Num a, Ord b) =>
(a, b) -> Maybe (a, (a, b))
unfold (Int
num, NumRange -> Int
range_bytes (Int
low, Int
high))
| NumRange -> Int
range_bytes (Int
low, Int
high) forall a. Eq a => a -> a -> Bool
== Int
1 = Word8 -> ByteString
B.singleton forall a b. (a -> b) -> a -> b
$ Int -> Int -> Word8
Sysex.from_signed Int
7 Int
num
| Bool
otherwise =
let b :: Word8
b = Int -> Int -> Word8
Sysex.from_signed Int
8 Int
num
in [Word8] -> ByteString
B.pack [forall a. Bits a => a -> Int -> a
Bits.shiftR Word8
b Int
7, Word8
b forall a. Bits a => a -> a -> a
.&. Word8
0x7f]
where
unfold :: (a, b) -> Maybe (a, (a, b))
unfold (a
num, b
left)
| b
left forall a. Ord a => a -> a -> Bool
> b
0 =
forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
num forall a. Bits a => a -> a -> a
.&. a
0x7f), (forall a. Bits a => a -> Int -> a
Bits.shiftR a
num Int
7, b
leftforall a. Num a => a -> a -> a
-b
1))
| Bool
otherwise = forall a. Maybe a
Nothing
range_bytes :: Sysex.NumRange -> Int
range_bytes :: NumRange -> Int
range_bytes (Int
low, Int
high) = forall a b. (RealFrac a, Integral b) => a -> b
ceiling forall a b. (a -> b) -> a -> b
$ forall a. Floating a => a -> a -> a
logBase Double
2 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
range forall a. Num a => a -> a -> a
+ Double
1) forall a. Fractional a => a -> a -> a
/ Double
7
where range :: Int
range = if Int
low forall a. Ord a => a -> a -> Bool
< Int
0 then Int
high forall a. Num a => a -> a -> a
- Int
low else Int
high
decode :: Specs -> ByteString -> Either String (Sysex.RMap, ByteString)
decode :: Specs -> ByteString -> Either String (RMap, ByteString)
decode = Config -> Specs -> ByteString -> Either String (RMap, ByteString)
Sysex.decode Config
config
encode :: Specs -> Sysex.RMap -> Either String ByteString
encode :: Specs -> RMap -> Either String ByteString
encode = Config -> Specs -> RMap -> Either String ByteString
Sysex.encode Config
config
assert_valid :: String -> Int -> Specs -> Specs
assert_valid :: String -> Int -> Specs -> Specs
assert_valid = Config -> String -> Int -> Specs -> Specs
Sysex.assert_valid Config
config
patch_spec :: Specs
patch_spec :: Specs
patch_spec = String -> Int -> Specs -> Specs
assert_valid String
"patch_spec" Int
size forall a b. (a -> b) -> a -> b
$
[ (String
"header", ByteString -> Spec
Constant (Int -> ByteString
vl1_header (Int
size forall a. Num a => a -> a -> a
- ByteString -> Int
B.length (Int -> ByteString
vl1_header Int
0))))
, (String
"memory type", Int -> Spec
unsigned Int
127)
, (String
"memory number", Int -> Spec
unsigned Int
127)
, (String
"", Int -> Spec
Unparsed Int
14)
] forall a. [a] -> [a] -> [a]
++ Specs
common_spec forall a. [a] -> [a] -> [a]
++ [(String
"element", Int -> Specs -> Spec
List Int
2 Specs
element_spec)]
where size :: Int
size = Int
3100
common_spec :: Specs
common_spec :: Specs
common_spec = String -> Int -> Specs -> Specs
assert_valid String
"common_spec" Int
108
[ (String
"name", Int -> Spec
Str Int
10)
, (String
"", Int -> Spec
Unparsed Int
6)
, (String
"key mode", [EnumName] -> Spec
enum [EnumName
"mono", EnumName
"unison", EnumName
"poly", EnumName
"part"])
, (String
"voice mode", [EnumName] -> Spec
enum [EnumName
"single", EnumName
"dual"])
, (String
"split mode", Int -> Spec
unsigned Int
2)
, (String
"split point", Int -> Spec
unsigned Int
127)
, (String
"split interval", Int -> Spec
unsigned Int
24)
, (String
"elem1 midi rch", Int -> Spec
unsigned Int
15)
, (String
"elem2 midi rch", Int -> Spec
unsigned Int
15)
, (String
"poly expand mode", Int -> Spec
unsigned Int
31)
, (String
"poly expand no", Int -> Spec
unsigned Int
31)
, (String
"pb, at & mod mode", Int -> Spec
unsigned Int
2)
, (String
"polyphony control", Int -> Spec
unsigned Int
119)
, (String
"sustain", Spec
bool)
, (String
"pitch bend mode", Int -> Spec
unsigned Int
2)
, (String
"assign mode", Int -> Spec
unsigned Int
2)
, (String
"breath attack time", Int -> Spec
unsigned Int
127)
, (String
"breath attack gain", Int -> Spec
unsigned Int
127)
, (String
"touch eg time", Int -> Spec
unsigned Int
127)
, (String
"touch eg gain", Int -> Spec
unsigned Int
127)
, (String
"portamento time midi control", Spec
bool)
, (String
"portamento mode", Int -> Spec
unsigned Int
1)
, (String
"portamento time", Int -> Spec
unsigned Int
127)
, (String
"elem1 portamento", Spec
bool)
, (String
"elem2 portamento", Spec
bool)
, (String
"elem1 detune", Int -> Spec
signed Int
7)
, (String
"elem2 detune", Int -> Spec
signed Int
7)
, (String
"elem1 note shift", Int -> Int -> Spec
ranged (-Int
64) Int
63)
, (String
"elem2 note shift", Int -> Int -> Spec
ranged (-Int
64) Int
63)
, (String
"elem1 rand pitch", Int -> Spec
unsigned Int
7)
, (String
"elem2 rand pitch", Int -> Spec
unsigned Int
7)
, (String
"elem1 microtuning", Int -> Spec
unsigned Int
86)
, (String
"elem2 microtuning", Int -> Spec
unsigned Int
86)
, (String
"elem1 level", Int -> Spec
unsigned Int
127)
, (String
"elem2 level", Int -> Spec
unsigned Int
127)
, (String
"elem1 pan l", Int -> Int -> Spec
ranged (-Int
64) Int
63)
, (String
"elem1 pan r", Int -> Int -> Spec
ranged (-Int
64) Int
63)
, (String
"elem2 pan l", Int -> Int -> Spec
ranged (-Int
64) Int
63)
, (String
"elem2 pan r", Int -> Int -> Spec
ranged (-Int
64) Int
63)
, (String
"cs1 class", Int -> Spec
unsigned Int
4)
, (String
"cs1 assign", Int -> Spec
unsigned Int
150)
, (String
"cs2 class", Int -> Spec
unsigned Int
4)
, (String
"cs2 assign", Int -> Spec
unsigned Int
150)
, (String
"destination effect", Int -> Spec
unsigned Int
3)
, (String
"destination controller", Int -> Spec
unsigned Int
122)
, (String
"effect type", [EnumName] -> Spec
enum
[ EnumName
"flanger", EnumName
"pitch change", EnumName
"distortion", EnumName
"chorus", EnumName
"phaser"
, EnumName
"symphonic", EnumName
"celeste", EnumName
"distortion+flanger", EnumName
"distortion+wah"
])
, (String
"elem1 on", [EnumName] -> Spec
enum [EnumName
"on", EnumName
"off"])
, (String
"elem2 on", [EnumName] -> Spec
enum [EnumName
"on", EnumName
"off"])
, (String
"effect", Int -> Spec
Unparsed Int
10)
, (String
"feedback/reverb mode", Spec
bool)
, (String
"feedback type", [EnumName] -> Spec
enum [EnumName
"off", EnumName
"mono", EnumName
"l/r", EnumName
"l/c/r"])
, (String
"feedback return", Int -> Spec
unsigned Int
100)
, (String
"feedback data", Int -> Spec
Unparsed Int
18)
, (String
"reverb type", Int -> Spec
unsigned Int
8)
, (String
"reverb data", Int -> Spec
Unparsed Int
10)
, (String
"", Int -> Spec
Unparsed Int
2)
]
unsigned1 :: Spec
unsigned1 :: Spec
unsigned1 = Int -> Spec
unsigned Int
127
signed64 :: Spec
signed64 :: Spec
signed64 = Int -> Int -> Spec
ranged (-Int
64) Int
63
element_spec :: Specs
element_spec :: Specs
element_spec = String -> Int -> Specs -> Specs
assert_valid String
"element_spec" Int
1480
[ (String
"control", Specs -> Spec
SubSpec Specs
controls_spec)
, (String
"trigger mode", Int -> Spec
unsigned Int
1)
, (String
"xfade speed", Int -> Spec
unsigned Int
96)
, (String
"interpolate speed", Int -> Spec
unsigned Int
50)
, (String
"breath noise", Specs -> Spec
SubSpec
[ (String
"level", Spec
unsigned1)
, (String
"level break", Int -> Spec
breakpoints64 Int
6)
, (String
"hpf", Int -> Spec
unsigned Int
125)
, (String
"hpf break", Int -> Spec
breakpoints64 Int
2)
, (String
"lpf", Spec
unsigned1)
, (String
"lpf break", Int -> Spec
breakpoints64 Int
2)
, (String
"noise", Int -> Spec
unsigned Int
22)
, (String
"key on reset", Spec
bool)
, (String
"slit drive", Int -> Spec
unsigned Int
32)
, (String
"control balance", Spec
signed64)
])
, (String
"throat formant", Specs -> Spec
SubSpec
[ (String
"pitch tracking", Spec
bool)
, (String
"pitch", Int -> Int -> Spec
ranged (-Int
128) Int
127)
, (String
"break", Int -> Spec
breakpoints127 Int
8)
, (String
"intensity", Int -> Spec
signed Int
127)
, (String
"intensity break", Int -> Spec
breakpoints127 Int
4)
, (String
"amount", Spec
signed64)
, (String
"amount break", Int -> Spec
breakpoints64 Int
4)
, (String
"hpf", Int -> Spec
unsigned Int
125)
, (String
"hpf break", Int -> Spec
breakpoints64 Int
3)
, (String
"lpf", Spec
unsigned1)
, (String
"lpf break", Int -> Spec
breakpoints64 Int
3)
])
, (String
"driver", Specs -> Spec
SubSpec
[ (String
"output", Spec
unsigned1)
, (String
"break", Int -> Spec
breakpoints64 Int
6)
])
, (String
"pipe/string", Specs -> Spec
SubSpec
[ (String
"output", Spec
unsigned1)
, (String
"break", Int -> Spec
breakpoints64 Int
6)
])
, (String
"tap", Specs -> Spec
SubSpec
[ (String
"output", Spec
unsigned1)
, (String
"break", Int -> Spec
breakpoints64 Int
6)
, (String
"sign", Int -> Spec
unsigned Int
1)
, (String
"setting", Int -> Spec
unsigned Int
4)
, (String
"location", Spec
unsigned1)
, (String
"location break", Int -> Spec
breakpoints64 Int
8)
])
, (String
"amplitude", Specs -> Spec
SubSpec
[ (String
"level", Spec
unsigned1)
, (String
"break", Int -> Spec
breakpoints64 Int
8)
])
, (String
"name", Int -> Spec
Str Int
10)
, (String
"", Int -> Spec
Unparsed Int
467)
, (String
"unparsed2", Int -> Spec
Unparsed Int
772)
]
breakpoints64 :: Int -> Spec
breakpoints64 :: Int -> Spec
breakpoints64 Int
n = Int -> Specs -> Spec
List Int
n
[ (String
"point", Spec
unsigned1)
, (String
"offset", Spec
signed64)
]
breakpoints127 :: Int -> Spec
breakpoints127 :: Int -> Spec
breakpoints127 Int
n = Int -> Specs -> Spec
List Int
n
[ (String
"point", Spec
unsigned1)
, (String
"offset", Int -> Spec
signed Int
127)
]
controls_spec :: Specs
controls_spec :: Specs
controls_spec =
[ (String
"pressure", Spec
c_simple)
, (String
"embouchure", Specs -> Spec
SubSpec
[(String, Spec)
c_control, (String, Spec)
c_mode, (String
"upper depth", Spec
depth), (String
"lower depth", Spec
depth)])
, (String
"pitch", Specs -> Spec
SubSpec
[ (String, Spec)
c_control, (String, Spec)
c_mode
, (String
"upper depth", Int -> Spec
signed Int
12), (String
"lower depth", Int -> Spec
signed Int
12)
])
, (String
"vibrato", Specs -> Spec
SubSpec [(String, Spec)
c_control, (String
"", Int -> Spec
Unparsed Int
1), (String, Spec)
c_depth])
, (String
"tonguing", Spec
c_simple)
, (String
"amplitude", Spec
c_simple)
, (String
"scream", Spec
c_complete)
, (String
"breath noise", Spec
c_complete)
, (String
"growl", Spec
c_complete)
, (String
"throat formant", Spec
c_complete)
, (String
"dynamic filter", Spec
c_simple)
, (String
"harmonic enhancer", Spec
c_simple)
, (String
"damping", Spec
c_simple)
, (String
"absorption", Spec
c_simple)
]
where
c_simple :: Spec
c_simple = Specs -> Spec
SubSpec [(String, Spec)
c_control, (String, Spec)
c_curve, (String, Spec)
c_depth]
c_complete :: Spec
c_complete = Specs -> Spec
SubSpec [(String, Spec)
c_control, (String, Spec)
c_value, (String, Spec)
c_curve, (String, Spec)
c_depth]
c_control :: (String, Spec)
c_control = (String
"control", Int -> Spec
unsigned Int
124)
c_value :: (String, Spec)
c_value = (String
"value", Int -> Spec
unsigned Int
127)
c_mode :: (String, Spec)
c_mode = (String
"mode", [EnumName] -> Spec
enum [EnumName
"mode1", EnumName
"mode2"])
c_curve :: (String, Spec)
c_curve = (String
"curve", Int -> Spec
signed Int
16)
c_depth :: (String, Spec)
c_depth = (String
"depth", Spec
depth)
depth :: Spec
depth = Int -> Spec
signed Int
127
effect_flanger :: Specs
effect_flanger :: Specs
effect_flanger =
[ (String
"wave", Int -> Spec
unsigned Int
2)
, (String
"freq", Int -> Spec
unsigned Int
127)
, (String
"depth", Int -> Spec
unsigned Int
100)
, (String
"delay", Int -> Spec
unsigned Int
126)
, (String
"phase", Int -> Spec
signed Int
8)
, (String
"fb gain", Int -> Spec
signed Int
100)
, (String
"high", Int -> Spec
unsigned Int
9)
, (String
"analog feel", Int -> Spec
unsigned Int
10)
, (String, Spec)
wet_dry
]
effect_pitch_change :: Specs
effect_pitch_change :: Specs
effect_pitch_change =
[ (String
"mode", Int -> Spec
unsigned Int
1)
, (String
"pitch 1", Int -> Spec
signed Int
12)
, (String
"fine 1", Int -> Spec
signed Int
100)
, (String
"out 1", Int -> Spec
unsigned Int
100)
, (String
"pitch 2", Int -> Spec
signed Int
12)
, (String
"fine 2", Int -> Spec
signed Int
100)
, (String
"out 2", Int -> Spec
unsigned Int
100)
, (String, Spec)
wet_dry
]
effect_distortion :: Specs
effect_distortion :: Specs
effect_distortion =
[ (String
"overdrive", Int -> Spec
unsigned Int
100)
, (String
"", Int -> Spec
Unparsed Int
2)
, (String
"device", Int -> Spec
unsigned Int
4)
, (String
"speaker", Int -> Spec
unsigned Int
5)
, (String
"presence", Int -> Spec
signed Int
10)
, (String
"output level", Int -> Spec
unsigned Int
100)
]
effect_chorus :: Specs
effect_chorus :: Specs
effect_chorus =
[ (String
"mode", Int -> Spec
unsigned Int
1)
, (String
"freq", Int -> Spec
unsigned Int
127)
, (String
"depth", Int -> Spec
unsigned Int
100)
, (String
"delay", Int -> Spec
unsigned Int
126)
, (String
"fb gain", Int -> Spec
signed Int
100)
, (String
"high", Int -> Spec
unsigned Int
9)
, (String, Spec)
wet_dry
]
effect_phaser :: Specs
effect_phaser :: Specs
effect_phaser =
[ (String
"mode", Int -> Spec
unsigned Int
1)
, (String
"stage", Int -> Spec
unsigned Int
3)
, (String
"freq", Int -> Spec
unsigned Int
127)
, (String
"depth", Int -> Spec
unsigned Int
100)
, (String
"offset", Int -> Spec
unsigned Int
100)
, (String
"phase", Int -> Spec
signed Int
8)
, (String
"fb gain", Int -> Spec
signed Int
100)
, (String, Spec)
wet_dry
]
effect_symphonic :: Specs
effect_symphonic :: Specs
effect_symphonic =
[ (String
"mode", Int -> Spec
unsigned Int
1)
, (String
"freq", Int -> Spec
unsigned Int
127)
, (String
"depth", Int -> Spec
unsigned Int
100)
, (String
"diffusion", Int -> Spec
unsigned Int
10)
, (String
"lo-fi", Int -> Spec
unsigned Int
12)
, (String, Spec)
wet_dry
]
effect_celeste :: Specs
effect_celeste :: Specs
effect_celeste =
[ (String
"mode", Int -> Spec
unsigned Int
1)
, (String
"freq", Int -> Spec
unsigned Int
127)
, (String
"depth", Int -> Spec
unsigned Int
100)
, (String
"delay", Int -> Spec
unsigned Int
126)
, (String
"fb gain", Int -> Spec
signed Int
100)
, (String
"lo-fi", Int -> Spec
unsigned Int
12)
, (String, Spec)
wet_dry
]
effect_distortion_flanger :: Specs
effect_distortion_flanger :: Specs
effect_distortion_flanger =
[ (String
"overdrive", Int -> Spec
unsigned Int
100)
, (String
"speaker", Int -> Spec
unsigned Int
5)
, (String
"output level", Int -> Spec
unsigned Int
100)
, (String
"freq", Int -> Spec
unsigned Int
127)
, (String
"depth", Int -> Spec
unsigned Int
100)
, (String
"delay", Int -> Spec
unsigned Int
126)
, (String
"phase", Int -> Spec
signed Int
8)
, (String
"fb gain", Int -> Spec
unsigned Int
100)
, (String
"high", Int -> Spec
unsigned Int
9)
, (String
"flanger balance", Int -> Spec
unsigned Int
100)
]
effect_distortion_wah :: Specs
effect_distortion_wah :: Specs
effect_distortion_wah =
[ (String
"overdrive", Int -> Spec
unsigned Int
100)
, (String
"speaker", Int -> Spec
unsigned Int
5)
, (String
"output level", Int -> Spec
unsigned Int
100)
, (String
"mode", Int -> Spec
unsigned Int
3)
, (String
"wah pre/post", Int -> Spec
unsigned Int
1)
, (String
"cutoff freq", Int -> Spec
unsigned Int
127)
, (String
"resonance", Int -> Spec
unsigned Int
127)
, (String
"sensitivity", Int -> Spec
unsigned Int
100)
]
wet_dry :: (String, Sysex.Spec)
wet_dry :: (String, Spec)
wet_dry = (String
"wet/dry balance", Int -> Spec
unsigned Int
100)