1 -- Basic Semantics V2 for a Reactive Music Cellular Automaton.
2 -- Inspired by the reacTogon.
3 -- Written by Henrik Nilsson, 2016-05-27
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.
15 -- * Add boolean flag to change direction to indicate start tile
17 -- * Change main routine to generate start play heads from board
19 -- * Add an optional restart facility: Maybe Int, restart every n
22 -- * Interpret a negative repeat as repeat indefinitely.
24 -- * Interpret a non-positve duration as mute: don't emit any note.
26 -- * Eliminate Ignore as now almost the same as Absorb with duration 0?
27 -- The only difference is that Absorb mostly overrides the repeat count.
28 -- Absorb = Stop {duration 0, repeat 1}
29 -- And as absorb might be a common case, it might be useful to have
30 -- a distinct graphical representation?
31 -- DECIDED AGAINST FOR NOW
33 module RCMA.Semantics where
36 import Data.List (intersperse, nub)
37 import Data.Maybe (catMaybes)
41 ------------------------------------------------------------------------------
42 -- Basic Type Synonyms
43 ------------------------------------------------------------------------------
45 -- Unipolar control value; [0, 1]
48 -- Bipolar control value; [-1, 1]
51 -- Unipolar control values are usually between 0 and 127.
52 toUCtrl :: Int -> UCtrl
53 toUCtrl x = fromIntegral x / 127
55 fromUCtrl :: UCtrl -> Int
56 fromUCtrl x = floor $ x * 127
58 -- Bipolar control values are usually between -127 and 127.
59 toBCtrl :: Int -> BCtrl
62 fromBCtrl :: BCtrl -> Int
65 ------------------------------------------------------------------------------
67 ------------------------------------------------------------------------------
71 ------------------------------------------------------------------------------
73 ------------------------------------------------------------------------------
75 -- The assumption is that the automaton is clocked by a beat clock and
76 -- thus advances one step per beat. For an automaton working in real time,
77 -- the beat clock would be defined externally, synchronized with other
78 -- layers and possibly external MIDI, and account for tempo, any swing, etc.
82 -- A beat as such is nothing.
85 -- Beats per Bar: number of beats per bar in the time signature of a layer.
87 type BeatsPerBar = Int
89 -- The beat number in the time signature of the layer. The first beat is 1.
92 nextBeatNo :: BeatsPerBar -> BeatNo -> BeatNo
93 nextBeatNo bpb bn = bn `mod` bpb + 1
97 -- Not needed for individual layers (at present)
104 ------------------------------------------------------------------------------
106 ------------------------------------------------------------------------------
108 -- This semantics mainly works with a high-level represemntation of notes.
109 -- But it is convenient to express some of the high-level aspects directly
110 -- in the corresponding MIDI terms to facilitate the translation.
112 -- MIDI note number; [0,127]
116 -- Assume MIDI convetion: 60 = "Middle C" = C4
121 -- MIDI velocity; [0,127]
125 -- MIDI Program Change: Program Number; [0,127]
129 -- MIDI Control Change: Control Number and Control Value; [0,127]
133 -- MIDICVRnd gives the option to pick a control value at random.
134 -- (Handled through subsequent translation to low-level MIDI events.)
135 data MIDICVRnd = MIDICV MIDICV | MIDICVRnd deriving (Eq, Show)
138 data Controller = Lol
140 ------------------------------------------------------------------------------
142 ------------------------------------------------------------------------------
146 -- We chose to represent pitch by MIDI note number
147 newtype Pitch = Pitch MIDINN deriving Eq
149 pitchToMNN :: Pitch -> MIDINN
150 pitchToMNN (Pitch nn) = nn
152 instance Show Pitch where
153 show (Pitch nn) = names !! note ++ show oct
157 oct = nn' `div` 12 + middleCOct
158 names = ["C", "C#", "D", "D#", "E", "F",
159 "F#", "G", "G#", "A", "A#", "B"]
161 -- Relative pitch in semi tones. Used for e.g. transposition.
167 -- Each layer has a setting that indicate how strongly the notes
168 -- should normally be played as a percentage of full strength.
169 -- (In the real application, this settig can be set to a fixed value
170 -- or set to be derived from teh last input note, "as played").
171 -- Individual notes can tehn be accented (played more strongly),
172 -- either unconditionally or as a function of the beat count.
174 type Strength = UCtrl
176 -- This could of course be generalised, e.g. a list of beat numbers to
177 -- accentuate. But this is simple and accounts for the most common patterns.
178 data Articulation = NoAccent
188 -- Articulated strength
189 articStrength :: Strength -> BeatNo -> Articulation -> Strength
190 articStrength st bn art
191 | accentedBeat = st * accentStrength
196 (_, NoAccent) -> False
199 (1, Accent13) -> True
200 (3, Accent13) -> True
201 (1, Accent14) -> True
202 (4, Accent14) -> True
203 (1, Accent24) -> True
204 (4, Accent24) -> True
210 -- Duration in terms of a whole note at the *system* tempo. (Each layer
211 -- is clocked at a layer beat that is a fraction/multiple of the system
212 -- tempo). Note that notes are played a little shorter than their nominal
213 -- duration. This is taken care of by the translation into low-level
214 -- MIDI events. (One might consider adding indications of staccato or
217 -- A non-positive duration is interpreted as mute: no note emitted.
218 type Duration = Rational
223 -- Notes can be ornamented. Traditionnally, ornamenting refers to modifications
224 -- of the pitch, such as a trill or a grace note. Here we use the term in
225 -- a generalised sense.
226 -- * A MIDI program change (to be sent before the note).
227 -- * A MIDI Continuous Controler Change (to be sent before the note).
229 -- One might also consider adding trills, grace notes, MIDI after touch ...
231 data Ornaments = Ornaments {
232 ornPC :: Maybe MIDIPN,
233 ornCC :: [(MIDICN, MIDICVRnd)],
234 ornSlide :: SlideType
237 data SlideType = NoSlide | SlideUp | SlideDn deriving (Eq, Show)
240 noOrn = Ornaments { ornPC = Nothing
247 -- Attributes needed to generate a note.
248 -- * The pitch of a note is given by the position on the board
249 -- * The strength is given by the layer strength, beat no., and articulation
250 -- * Duratio and Ornamentatio are stored
251 data NoteAttr = NoteAttr {
252 naArt :: Articulation,
258 -- High level note representation emitted form a layer
267 ------------------------------------------------------------------------------
269 ------------------------------------------------------------------------------
271 -- Numbering; row number inside tile, column number below:
282 -- Angle measured in multiples of 60 degrees.
285 data Dir = N | NE | SE | S | SW | NW deriving (Enum, Eq, Show)
288 turn :: Dir -> Angle -> Dir
289 turn d a = toEnum ((fromEnum d + a) `mod` 6)
292 type Pos = (Int, Int)
294 -- Position of neighbour in given direction
295 neighbor :: Dir -> Pos -> Pos
296 neighbor N (x,y) = (x, y + 1)
297 neighbor NE (x,y) = (x + 1, y + 1 - x `mod` 2)
298 neighbor SE (x,y) = (x + 1, y - x `mod` 2)
299 neighbor S (x,y) = (x, y - 1)
300 neighbor SW (x,y) = (x - 1, y - x `mod` 2)
301 neighbor NW (x,y) = (x - 1, y + 1 - x `mod` 2)
304 -- Position and transposition to pitch:
305 -- * Harmonic Table" layout: N = +7; NE = +4; SE = -3
306 -- * (0,0) assumed to be "Middle C"
307 posToPitch :: Pos -> RelPitch -> Pitch
308 posToPitch (x,y) tr =
309 Pitch (y * 7 + x `div` 2 - 3 * (x `mod` 2) + middleC + tr)
313 -- A ChDir counter is optionally a start counter if the Boolean flag is
315 -- Any counter can be made silent by setting the note duration to a
316 -- non-positive number.
318 data Action = Inert -- No action, play heads move through.
319 | Absorb -- Remove play head silently.
320 | Stop NoteAttr -- Play note then remove play head.
321 | ChDir Bool NoteAttr Dir -- Play note then change direction.
322 | Split NoteAttr -- Play note then split head into five.
327 -- A cell stores an action and a repetition number.
328 -- 0: the cell is completely bypassed, as if it wasn't there.
329 -- 1: the action is carried out once (default)
330 -- n > 1: any note output of the action is repeated (n-1) times before the
331 -- action is carried out.
332 -- n < 0: any note output of the action is repeated indefinitely (oo).
334 type Cell = (Action, Int)
337 -- Make a cell with a default repeat count of 1.
338 mkCell :: Action -> Cell
339 mkCell a = mkCellRpt a 1
342 -- Make a cell with a non-default repeition number.
343 mkCellRpt :: Action -> Int -> Cell
344 mkCellRpt a n = (a, n)
347 -- Board extent: south-west corner and north-east corner.
348 -- This covers most of the MIDI range: A#-1 (10) to G7 (103).
354 -- Test if a position is on the board as defined by swc and nec.
355 -- The assumption is that odd columns contain one more cell, as per the
356 -- picture above. Of course, one could opt for a "zig-zag" layout
357 -- with each column having the same number of cells which would be slightly
359 onBoard :: Pos -> Bool
360 onBoard (x,y) = xMin <= x && x <= xMax
368 (xMax, yMax) = case nec of
369 (x, y) | even x -> (x, y + 1)
370 | otherwise -> (x, y)
373 type Board = Array Pos Cell
376 -- Build a board from a list specifying the non-empty cells.
377 makeBoard :: [(Pos, Cell)] -> Board
380 ([(p, if onBoard p then mkCell Inert else mkCell Absorb)
381 | p <- range (swc, nec')]
382 ++ [(p,c) | (p, c) <- pcs, onBoard p])
384 -- This is to ensure (neighbor NW nec) is included on the board,
385 -- regardless of whether the column of nec is even or odd.
386 -- Otherwise, due to the "jagged" upper edge, the top row would
387 -- be missing, but every other cell of that *is* on the board.
388 -- The "superfluous" cells are set to Absorb above.
389 nec' = neighbor N nec
393 lookupCell :: Board -> Pos -> Cell
394 lookupCell b p = if onBoard p then (b ! p) else (Absorb, 1)
397 ------------------------------------------------------------------------------
399 ------------------------------------------------------------------------------
401 -- A play head is characterised by:
402 -- * Current position
403 -- * Number of beats before moving
404 -- * Direction of travel
405 -- If an action involves playing a note, this is repeated once for
406 -- each beat the play head is staying, with the rest of the action
407 -- carried out at the last beat.
418 ------------------------------------------------------------------------------
420 ------------------------------------------------------------------------------
422 startHeads :: Board -> [PlayHead]
429 | (p, (ChDir True _ d, n)) <- assocs bd ]
432 ------------------------------------------------------------------------------
434 ------------------------------------------------------------------------------
436 -- Advance the state of a single play head.
438 -- The result is a list of heads to be actioned at the *next* beat
439 -- later) and possibly a note to be played at *this* beat.
441 advanceHead :: Board -> BeatNo -> RelPitch -> Strength -> PlayHead
442 -> ([PlayHead], Maybe Note)
443 advanceHead bd bn tr st ph = ahAux (moveHead bd ph)
445 ahAux ph@PlayHead {phPos = p, phBTM = btm, phDir = d} =
446 case fst (lookupCell bd p) of
447 Inert -> ([ph], Nothing)
448 Absorb -> ([], Nothing) -- No point waiting until BTM=0
449 Stop na -> (newPHs [], mkNote p bn tr st na)
450 ChDir _ na d' -> (newPHs [ph {phDir = d'}],
451 mkNote p bn tr st na)
452 Split na -> (newPHs [ PlayHead {
460 mkNote p bn tr st na)
462 newPHs phs = if btm == 0 then phs else [ph]
465 -- Moves a play head if the BTM counter has reached 0, otherwise decrement BTM.
466 -- Any encountered cells where the repeat count is < 1 are skipped.
467 moveHead :: Board -> PlayHead -> PlayHead
468 moveHead bd (ph@PlayHead {phPos = p, phBTM = btm, phDir = d})
471 btm' = snd (lookupCell bd p')
473 moveHead bd (ph {phPos = p', phBTM = btm'})
474 | btm > 0 = ph {phBTM = btm - 1}
475 | otherwise = ph -- Repeat indefinitely
477 mkNote :: Pos -> BeatNo -> RelPitch -> Strength -> NoteAttr -> Maybe Note
478 mkNote p bn tr st na@(NoteAttr {naDur = d})
479 | d <= 0 = Nothing -- Notes of non-positive length are silent.
482 notePch = posToPitch p tr,
483 noteStr = articStrength st bn (naArt na),
489 -- Advance a list of heads, collecting all resulting heads and notes.
490 -- Any duplicate play heads are eliminated (or their number may uselessly
491 -- grow very quickly), and a cap (50, arbitrary, but should be plenty,
492 -- expecially given the board size) on the number of simultaneous playheads
493 -- per layer is imposed.
494 advanceHeads :: Board -> BeatNo -> RelPitch -> Strength -> [PlayHead]
495 -> ([PlayHead], [Note])
496 advanceHeads bd bn tr st phs =
498 (phss, mns) = unzip (map (advanceHead bd bn tr st) phs)
500 (take 50 (nub (concat phss)), catMaybes mns)
503 -- Given a board with start counters, run a board indefinitely, optionally
504 -- restarting every ri bars.
508 -- (2) Beats Per Bar (bpb); > 0
509 -- (3) Optioal repeat Interval (mri); In bars.
510 -- (4) Transposition (tr)
514 -- Stream of notes played at each beat.
516 -- In the real implementation:
517 -- * A layer beat clock would be derived from the system beat (as a
518 -- fraction/multiple, adding any swing) and each clock event be tagged
519 -- with the beat number.
520 -- * The board (bd) would not necessarily be a constant input. (One might
521 -- consider allowing editing a layer while the machine is running)
522 -- * The time signature, and thus the beats per par (bpb), along with
523 -- repeat interval (ri) would likely be static (only changeable while
524 -- automaton is stopped).
525 -- * The transposition (tr) would be dynamic, the sum of a per layer
526 -- transposition that can be set through the user interface and the
527 -- difference between the MIDI note number of the last external
528 -- note received for the layer and middle C (say).
529 -- * The strength (st) would be dynamic, configurable as either the strength
530 -- set through the user interface or the strength of the last external
531 -- note received for the layer (derived from its MIDI velocity).
533 runRMCA :: Board -> BeatsPerBar -> Maybe Int -> RelPitch -> Strength
535 runRMCA bd bpb mri tr st
540 | ri > 0 -> cycle (take (ri * bpb) nss)
541 | otherwise -> error "The repeat interval must be at \
543 | otherwise = error "The number of beats per bar must be at least 1."
545 nss = runAux 1 (startHeads bd)
547 runAux bn phs = ns : runAux (nextBeatNo bpb bn) phs'
549 (phs', ns) = advanceHeads bd bn tr st phs
552 -- Print played notes in a time-stamped (bar, beat), easy-to-read format.
554 ppNotes :: BeatsPerBar -> [[Note]] -> IO ()
555 ppNotes bpb nss = ppnAux (zip [(br,bn) | br <- [1..], bn <- [1..bpb]] nss)
557 ppnAux [] = return ()
558 ppnAux ((_, []) : tnss) = ppnAux tnss
559 ppnAux ((t, ns) : tnss) = do
560 putStrLn ((leftJustify 10 (show t)) ++ ": "
561 ++ concat (intersperse ", " (map show ns)))
565 leftJustify :: Int -> String -> String
566 leftJustify w s = take (w - length s) (repeat ' ') ++ s
569 ------------------------------------------------------------------------------
571 ------------------------------------------------------------------------------
574 makeBoard [((0,0), mkCell (ChDir True na1 N)),
575 ((0,1), mkCell (ChDir False na1 SE)),
576 ((1,1), mkCell (Split na1)),
577 ((1,-1), mkCell (Split na1)),
578 ((-1,0), mkCell (ChDir False na2 NE))]
581 makeBoard [((0,0), mkCell (ChDir False na1 N)),
582 ((0,1), mkCell (ChDir False na1 SE)),
583 ((1,1), mkCell (Split na1)),
584 ((1,-1), mkCell (Split na1)),
585 ((-1,0), mkCell (ChDir False na2 NE))]
588 makeBoard [((0,0), mkCell (ChDir True na1 N)),
589 ((0,2), mkCellRpt (ChDir False na2 SE) 3),
590 ((2,1), mkCell (ChDir False na1 SW)),
591 ((1,1), mkCellRpt (ChDir False na1 N) 0) {- Skipped! -},
592 ((0,4), mkCellRpt (ChDir True na1 N) (-1)) {- Rpt indef. -},
593 ((0, -6), mkCell (ChDir True na1 N)),
594 ((0, -2), mkCell (ChDir False na3 S) {- Silent -})]
597 makeBoard [((0,0), mkCell (ChDir True na1 N))]
602 naOrn = Ornaments Nothing [] NoSlide
608 naOrn = Ornaments Nothing [(10, MIDICVRnd)] SlideUp
614 naOrn = Ornaments Nothing [] NoSlide
621 main = ppNotes bpb (take 50 (runRMCA testBoard3 bpb (Just 2) 0 0.8))