1 -- Basic Semantics for a Reactive Music Cellular Automaton.
2 -- Inspired by the reacTogon.
3 -- Written by Henrik Nilsson, 2016-05-03
4 -- Based on an earlier version.
6 -- This gives the semantics of a single RCMA layer. The output is
7 -- a high-level representation of notes for each beat. This is to be
8 -- translated to low-level MIDI message by a subsequent translator
9 -- responsible for merging notes from different layers, ensuring that
10 -- a note off message corresponding to each note on message is always
11 -- emitted after the appropriate time, rendering any embellismnets
12 -- such as slides (while not generating too much MIDI data), etc.
14 module RMCASemantics where
17 import Data.Maybe (catMaybes)
18 import Data.List (nub, intersperse)
22 ------------------------------------------------------------------------------
23 -- Basic Type Synonyms
24 ------------------------------------------------------------------------------
26 -- Unipolar control value; [0, 1]
29 -- Bipolar control value; [-1, 1]
33 ------------------------------------------------------------------------------
35 ------------------------------------------------------------------------------
37 -- The assumption is that the automaton is clocked by a beat clock and
38 -- thus advances one step per beat. For an automaton working in real time,
39 -- the beat clock would be defined externally, synchronized with other
40 -- layers and possibly external MIDI, and account for tempo, any swing, etc.
44 -- Beats per Bar: number of beats per bar in the time signature of a layer.
46 type BeatsPerBar = Int
48 -- The beat number in the time signature of the layer. The first beat is 1.
51 nextBeatNo :: BeatsPerBar -> BeatNo -> BeatNo
52 nextBeatNo bpb bn = bn `mod` bpb + 1
56 -- Not needed for individual layers (at present)
63 ------------------------------------------------------------------------------
65 ------------------------------------------------------------------------------
67 -- This semantics mainly works with a high-level represemntation of notes.
68 -- But it is convenient to express some of the high-level aspects directly
69 -- in the corresponding MIDI terms to facilitate the translation.
71 -- MIDI note number; [0,127]
75 -- Assume MIDI convetion: 60 = "Middle C" = C4
80 -- MIDI velocity; [0,127]
84 -- MIDI Program Change: Program Number; [0,127]
88 -- MIDI Control Change: Control Number and Control Value; [0,127]
92 -- MIDICVRnd gives the option to pick a control value at random.
93 -- (Handled through subsequent translation to low-level MIDI events.)
94 data MIDICVRnd = MIDICV MIDICV | MIDICVRnd deriving (Eq, Show)
97 ------------------------------------------------------------------------------
99 ------------------------------------------------------------------------------
103 -- We chose to represent pitch by MIDI note number
104 newtype Pitch = Pitch MIDINN deriving Eq
106 pitchToMNN :: Pitch -> MIDINN
107 pitchToMNN (Pitch nn) = nn
109 instance Show Pitch where
110 show (Pitch nn) = names !! note ++ show oct
114 oct = nn' `div` 12 + middleCOct
115 names = ["C", "C#", "D", "D#", "E", "F",
116 "F#", "G", "G#", "A", "A#", "B"]
118 -- Relative pitch in semi tones. Used for e.g. transposition.
124 -- Each layer has a setting that indicate how strongly the notes
125 -- should normally be played as a percentage of full strength.
126 -- (In the real application, this settig can be set to a fixed value
127 -- or set to be derived from teh last input note, "as played").
128 -- Individual notes can tehn be accented (played more strongly),
129 -- either unconditionally or as a function of the beat count.
131 type Strength = UCtrl
133 -- This could of course be generalised, e.g. a list of beat numbers to
134 -- accentuate. But this is simple and accounts for the most common patterns.
135 data Articulation = NoAccent
145 -- Articulated strength
146 articStrength :: Strength -> BeatNo -> Articulation -> Strength
147 articStrength st bn art
148 | accentedBeat = st * accentStrength
153 (_, NoAccent) -> False
156 (1, Accent13) -> True
157 (3, Accent13) -> True
158 (1, Accent14) -> True
159 (4, Accent14) -> True
160 (1, Accent24) -> True
161 (4, Accent24) -> True
167 -- Duration in terms of a whole note at the *system* tempo. (Each layer
168 -- is clocked at a layer beat that is a fraction/multiple of the system
169 -- tempo). Note that notes are played a little shorter than their nominal
170 -- duration. This is taken care of by the translation into low-level
171 -- MIDI events. (One might consider adding indications of staccato or
173 type Duration = Rational
178 -- Notes can be ornamented. Traditionnally, ornamenting refers to modifications
179 -- of the pitch, such as a trill or a grace note. Here we use the term in
180 -- a generalised sense.
181 -- * A MIDI program change (to be sent before the note).
182 -- * A MIDI Continuous Controler Change (to be sent before the note).
184 -- One might also consider adding trills, grace notes, MIDI after touch ...
186 data Ornaments = Ornaments {
187 ornPC :: Maybe MIDIPN,
188 ornCC :: [(MIDICN, MIDICVRnd)],
189 ornSlide :: SlideType
192 data SlideType = NoSlide | SlideUp | SlideDn deriving (Eq, Show)
197 -- Attributes needed to generate a note.
198 -- * The pitch of a note is given by the position on the board
199 -- * The strength is given by the layer strength, beat no., and articulation
200 -- * Duratio and Ornamentatio are stored
201 data NoteAttr = NoteAttr {
202 naArt :: Articulation,
208 -- High level note representation emitted form a layer
217 ------------------------------------------------------------------------------
219 ------------------------------------------------------------------------------
221 -- Numbering; row number inside tile, column number below:
232 -- Angle measured in multiples of 60 degrees.
235 data Dir = N | NE | SE | S | SW | NW deriving (Enum, Eq, Show)
238 turn :: Dir -> Angle -> Dir
239 turn d a = toEnum ((fromEnum d + a) `mod` 6)
242 type Pos = (Int, Int)
244 -- Position of neighbour in given direction
245 neighbor :: Dir -> Pos -> Pos
246 neighbor N (x,y) = (x, y + 1)
247 neighbor NE (x,y) = (x + 1, y + 1 - x `mod` 2)
248 neighbor SE (x,y) = (x + 1, y - x `mod` 2)
249 neighbor S (x,y) = (x, y - 1)
250 neighbor SW (x,y) = (x - 1, y - x `mod` 2)
251 neighbor NW (x,y) = (x - 1, y + 1 - x `mod` 2)
254 -- Position and transposition to pitch:
255 -- * Harmonic Table" layout: N = +7; NE = +4; SE = -3
256 -- * (0,0) assumed to be "Middle C"
257 posToPitch :: Pos -> RelPitch -> Pitch
258 posToPitch (x,y) tr =
259 Pitch (y * 7 + x `div` 2 - 3 * (x `mod` 2) + middleC + tr)
263 -- Maybe this coul dbe refined: some of the actions might be useful
264 -- both in note playing and silent versions: e.g. changing direction without
265 -- playing a note; playing a note without changing direction.
267 data Action = Inert -- No action, play heads just move through.
268 | Absorb -- Remove play head silently.
269 | Stop NoteAttr -- Play note then remove play head.
270 | ChDir NoteAttr Dir -- Play note then change direction.
271 | Split NoteAttr -- Play note then split head into five new.
276 -- A cell stores an action and a repetition number.
277 -- 0: the cell is completely bypassed, as if it wasn't there.
278 -- 1: the action is carried out once (default)
279 -- n > 1: any note output of the action is repeated (n-1) times before the
280 -- action is carried out.
282 type Cell = (Action, Int)
285 -- Make a cell with a default repeat count of 1.
286 mkCell :: Action -> Cell
287 mkCell a = mkCellRpt a 1
290 -- Make a cell with a non-default repeition number.
291 mkCellRpt :: Action -> Int -> Cell
292 mkCellRpt a n | n >= 0 = (a, n)
293 | otherwise = error "The repetition number of a cell must be \
297 -- Board extent: south-west corner and north-east corner.
298 -- This covers most of the MIDI range: A#-1 (10) to G7 (103).
304 -- Test if a position is on the board as defined by swc and nec.
305 -- The assumption is that odd columns contain one more cell, as per the
306 -- picture above. Of course, one could opt for a "zig-zag" layout
307 -- with each column having the same number of cells which would be slightly
309 onBoard :: Pos -> Bool
310 onBoard (x,y) = xMin <= x && x <= xMax
318 (xMax, yMax) = case nec of
319 (x, y) | even x -> (x, y + 1)
320 | otherwise -> (x, y)
323 type Board = Array Pos Cell
326 -- Build a board from a list specifying the non-empty cells.
327 makeBoard :: [(Pos, Cell)] -> Board
330 ([(p, if onBoard p then mkCell Inert else mkCell Absorb)
331 | p <- range (swc, nec')]
332 ++ [(p,c) | (p, c) <- pcs, onBoard p])
334 -- This is to ensure (neighbor NW nec) is included on the board,
335 -- regardless of whether the column of nec is even or odd.
336 -- Otherwise, due to the "jagged" upper edge, the top row would
337 -- be missing, but every other cell of that *is* on the board.
338 -- The "superfluous" cells are set to Absorb above.
339 nec' = neighbor N nec
343 lookupCell :: Board -> Pos -> Cell
344 lookupCell b p = if onBoard p then (b ! p) else (Absorb, 1)
347 ------------------------------------------------------------------------------
349 ------------------------------------------------------------------------------
351 -- A play head is characterised by:
352 -- * Current position
353 -- * Number of beats before moving
354 -- * Direction of travel
355 -- If an action involves playing a note, this is repeated once for
356 -- each beat the play head is staying, with the rest of the action
357 -- carried out at the last beat.
368 ------------------------------------------------------------------------------
370 ------------------------------------------------------------------------------
372 -- Advance the state of a single play head.
374 -- The result is a list of heads to be actioned at the *next* beat
375 -- later) and possibly a note to be played at *this* beat.
377 advanceHead :: Board -> BeatNo -> RelPitch -> Strength -> PlayHead
378 -> ([PlayHead], Maybe Note)
379 advanceHead bd bn tr st ph = ahAux (moveHead bd ph)
381 ahAux ph@PlayHead {phPos = p, phBTM = btm, phDir = d} =
382 case fst (lookupCell bd p) of
383 Inert -> ([ph], Nothing)
384 Absorb -> ([], Nothing) -- No point waiting until BTM=0
385 Stop na -> (newPHs [], Just (mkNote p bn tr st na))
386 ChDir na d' -> (newPHs [ph {phDir = d'}],
387 Just (mkNote p bn tr st na))
388 Split na -> (newPHs [ PlayHead {
396 Just (mkNote p bn tr st na))
398 newPHs phs = if btm > 0 then [ph] else phs
401 -- Moves a play head if the BTM counter has reached 0, otherwise decrement BTM.
402 -- Any encountered cells where the repeat count is < 1 are skipped.
403 moveHead :: Board -> PlayHead -> PlayHead
404 moveHead bd (ph@PlayHead {phPos = p, phBTM = btm, phDir = d})
407 btm' = snd (lookupCell bd p')
409 moveHead bd (ph {phPos = p', phBTM = btm'})
410 | otherwise = ph {phBTM = btm - 1}
413 mkNote :: Pos -> BeatNo -> RelPitch -> Strength -> NoteAttr -> Note
414 mkNote p bn tr st na =
416 notePch = posToPitch p tr,
417 noteStr = articStrength st bn (naArt na),
423 -- Advance a list of heads, collecting all resulting heads and notes.
424 -- Any duplicate play heads are eliminated (or their number may uselessly
425 -- grow very quickly), and a cap (50, arbitrary, but should be plenty,
426 -- expecially given the board size) on the number of simultaneous playheads
427 -- per layer is imposed.
428 advanceHeads :: Board -> BeatNo -> RelPitch -> Strength -> [PlayHead]
429 -> ([PlayHead], [Note])
430 advanceHeads bd bn tr st phs =
432 (phss, mns) = unzip (map (advanceHead bd bn tr st) phs)
434 (take 50 (nub (concat phss)), catMaybes mns)
437 -- Given an initial list of play heads, run a board until there are no
438 -- more heads (or "forever", if that does not happen). The result is
439 -- a list of all notes played for each pulse.
441 -- Note: The original rcma has special start counters. An "internal"
442 -- board as defined here along with a list of inital read heads could
443 -- be derived from an "external" board representation more closely aligned
444 -- with the GUI represenatation.
446 -- In the real implementation:
447 -- * A layer beat clock would be derived from the system beat (as a
448 -- fraction/multiple, adding any swing) and each clock event be tagged
449 -- with the beat number.
450 -- * The board would not necessarily be a constant input. (One might
451 -- consider allowing editing a layer while the machine is running)
452 -- * The time signature and thus the beats per par would not necessarily
453 -- be a constant input (one might consider allowing changing it while
454 -- the machine is running, but perhaps not very useful).
455 -- * The transposition would be dynamic, the sum of a per layer
456 -- transposition that can be set through the user interface and the
457 -- difference between the MIDI note number of the last external
458 -- note received for the layer and middle C (say).
459 -- * The strength would be dynamic, configurable as either the strength
460 -- set through the user interface or the strength of the last external
461 -- note received for the layer (derived from its MIDI velocity).
463 runRMCA :: Board -> BeatsPerBar -> RelPitch -> Strength -> [PlayHead]
465 runRMCA _ _ _ _ [] = []
466 runRMCA bd bpb tr st phs = runAux 1 phs
468 runAux bn phs = ns : runAux (nextBeatNo bpb bn) phs'
470 (phs', ns) = advanceHeads bd bn tr st phs
473 -- Print played notes in a time-stamped (bar, beat), easy-to-read format.
475 ppNotes :: BeatsPerBar -> [[Note]] -> IO ()
476 ppNotes bpb nss = ppnAux (zip [(br,bn) | br <- [1..], bn <- [1..bpb]] nss)
478 ppnAux [] = return ()
479 ppnAux ((_, []) : tnss) = ppnAux tnss
480 ppnAux ((t, ns) : tnss) = do
481 putStrLn ((leftJustify 10 (show t)) ++ ": "
482 ++ concat (intersperse ", " (map show ns)))
486 leftJustify :: Int -> String -> String
487 leftJustify w s = take (w - length s) (repeat ' ') ++ s
490 ------------------------------------------------------------------------------
492 ------------------------------------------------------------------------------
494 -- testBoard = makeBoard [((0,0), mkCell (ChDir na1 N)),
495 -- ((0,1), mkCell (ChDir na1 SE)),
496 -- ((1,1), mkCell (Split na1)),
497 -- ((1,-1), mkCell (Split na1)),
498 -- ((-1,0), mkCell (ChDir na2 NE))]
500 testBoard = makeBoard [((0,0), mkCell (ChDir na1 N)),
501 ((0,2), mkCellRpt (ChDir na2 SE) 3),
502 ((2,1), mkCell (ChDir na1 SW)),
503 ((1,1), mkCellRpt (ChDir na1 N) 0) {- Skipped! -}]
508 naOrn = Ornaments Nothing [] NoSlide
514 naOrn = Ornaments Nothing [(10, MIDICVRnd)] SlideUp
520 main = ppNotes bpb (take 50 (runRMCA testBoard
524 [PlayHead (0,0) 1 N]))