Journal d'une exploration

Table of Contents

1. TidalCycle

2. Les contrepoints

import qualified Data.Map.Strict as Map
import Data.Maybe

I want to play with the counterpoint. Counterpoints are a wide subject and i cannot pretend this text to be exhaustive. For a deeper understanding one can read (Gallon and Bitsch), or browse one of the existing implementations. For our concern, i'll retain the rules :

  1. Have a cantus firmus, which serves as a base, and some voices
  2. Work in major mode
  3. Notes for the voices are randomly choosen
  4. Notes starting a measure from voice and cantus firmus, are in consonance

This document is literate programming of tidal, source code available here

Start with a cantus firmus and 2 voices in major mode. One measure is 4 quartet and we append 2 measures. Notes for voices are randomly choose from the major scale and structure is deterministly defined 

d1 $ let
base = "major"
sm = scale base "0..7" -- major mode
cantusf =  cat [n "c@2 f d ", n "[f@0.5 ~] a d ~ g!2"]
smv = choose (map eventValue (queryArc sm (Arc 0 1)))
v1 = cat [struct "[1@0.5 ~] 1 [1@0.5 ~] 1" $ smv , struct "~ 1 ~ 1"$ smv]
v2 = cat [struct "1 <1, [1*3]> 1 1" $ smv, struct  "1@2 1@2" $ smv]
  in stack [ cantusf,
             v1 |- 12  # pan 0.25 ,
             v2 |- 24  # pan 0.75]
     |>| s "supermandolin"

At this point, no constraint is set on the first notes of each measure despite rigorous counterpoint requires it (see contrepoints). what would be nice is to replace notes in such a way that first notes forms either a octave, a five, a third (major/minor) , or a siw (major/minor), that is the consonance.

A first approach is to alter a voice by applying a function on the first note and replace it such that we build a consonance with cantus firmus :

chord semitone
octave 12
five 7
third major 4
third minor 3
six major 8
six minor 9 
ns = [12, 7, 4, 3, 8, 9]
pat |> choose ns

First, we know how to decide if an event starts with a cycle : 

fe (Event _ _ part _) = (sect (Arc 0 0) (cycleArc part)) == (Arc 0 0)
te (Event _ _ part _) = (sect (Arc 0 0) (cycleArc part)) /= (Arc 0 0)

We are now able to split a voice on two patterns using filterEvents: one containing only the events intersecting the beginning of a cycle and the other the remainings events.

We want the structure of the first but replacing its value with a randomly choosen note, we'll use choose for this 

(filterEvents fe $ n "1 2") |> choose [2,3,4]

Finally, we wrap all this up. Note that we restrict to 2 voices 

consonance ns voice = stack [filterEvents fe voice |> (note $ choose ns), filterEvents te voice]
  where
      fe (Event _ _ part _) = (sect (Arc 0 0) (cycleArc part)) == (Arc 0 0)
      te (Event _ _ part _) = (sect (Arc 0 0) (cycleArc part)) /= (Arc 0 0)

which applied to one of our voice of our initial example gives: 

d1 $ let
base = "major"
ns = [12,7, 4, 3, 8, 9]
sm = scale base "0..7" -- major mode
cantusf =  cat [n "c@2 f d ",n "[f@0.5 ~] a d ~ g!2"]
smv = choose (map eventValue (queryArc sm (Arc 0 1)))
v1 = cat [struct "[1@0.5 ~] 1 [1@0.5 ~] 1" $ smv, struct "~ 1 ~ 1"$ smv]
  in stack [ cantusf,
             consonance ns (v1 |- 12  # pan 0.25)]
     |>| s "supermandolin"

It could be nice to setup a function for such counterpoint. 

counterpoint' sm cfs vs =
   let
     ns = [12, 7, 4, 3, 8, 9]
     smv = map eventValue (queryArc sm (Arc 0 1))
     voice = cat $ (\v -> struct v (note $ choose smv)) <$> vs
   in stack [cat cfs, consonance ns voice]

One limitation is that if we apply consonance to more than one voice, we could not guarantee the property. Indeed, note are randomly choose and there is no relation between theses choices within the stack function.

Here, an example,: 

d1 $
 let
   v =  [every 3 rev $ "[~ 1]!4", "<[1*2 ~] [1 ~]>!2", "1@2 1@2", every 3 (fast 2) $ "0 1 0 1"] :: [Pattern Bool]
   cf = note <$> ["c f d g", every 4 (inside 2 rev) $  "c [f g a] d g", "c [f g a] [d b c] g", "f [c g a] d g"]
 in
   rotR (1/12) $ every 8 (jux ((#gain 0.8).rev)) $ counterpoint' (scale "minor" "0..3" |+ "9") ((|+ 0) <$> cf) v
   # s "supermandolin"
   # legato 1

And one more involve using legowert sirius,LEGOWELT DRUM WIZARDRY SAMPLE PACK, minimoog, all renamed1 

d1 $
 let
   base = "[cs] [~ g] [~ d] [~ ef]"
   v =  ["[<1!2 1!4> ~]!4"] :: [Pattern Bool]
   cf = note <$> [base]
 in
   stack [
    every 8 (jux ((#gain 0.8).rev)) $ counterpoint' (scale "minor" "0..3" |+ "9" |- "12") ((|- 12) <$> cf) v
   # s "lwmsy:6"
   # legato 1
   # gain 0.8,
    note base # s "lwssy:1" # legato 1]

d2 $ stack [s "lwwbd:1!4", s "[~ lwwbd:5]!4" # gain "[0.7 0.6]!2", fast 2 $ press $ s "lwwsd:2" # legato 1]

d3 $ press $ s "lwwhh:2!4"

3. Tidal mode for emacs with treesiter

Emacs 29+ comes with treesit, an integration fo the tree-sitter library. Basically, it constructs a syntax tree of a source file thus giving us a representation of the program usable for such things as syntax highlighting and motions. We can then configure treesit to handle our beloved pattern.

It turns out that this need some minor tidal-mode updates, which i describe in this entry. Some folks provides a haskell-ts-mode, an haskell mode using treesit. As you may know, tidal inherits haskell-mode. Changing this inheritance to haskell-ts-mode is hence a first easy step. 

(define-derived-mode tidal-mode haskell-ts-mode

It is then required to update some of the haskell-ts-mode variables.

3.1. Highlights

Treesit is faster and more accurate than traditional fontification method (ie: font-lock). As tidal pattern languages is (simpler) haskel code, all we have to do is to tune haskell-ts-mode variables specifically for tidal. Tidal programms are basically a sequences of infix operator having function application as operand, the outer ones havin as left operand a runner (eg: d1). It's easy to see the structure of a tidal pattern with the treesit-explore-mode, which prints a string representation of the the syntax tree. Nevertheless, it's perfectly acceptable to have haskell code in a tidal file requiring to keep the haskell-ts fontification construct.

Each patterns are encapsulated in a topsplice, and tidal function name are classified as variables. As first example, consider the query for hush: 

`(((top_splice (variable) @tidal-hush-face) (:match "hush" @tidal-hush-face)))

The syntax and semantics of query are described in the treesit documentation. We associate a face name as a capture name which automatically set the face for the matched code in the source file. Next we can match the runner name and assign it the tidal-runner-face 

`((top_splice
   (infix left_operand: (_) @tidal-runner-face 
            operator: (_))))

Function calls (eg: s "bd*4") are captued as follow, thanks to the haskell's tree-sitter gramar. It suffices to fontify the variable with the tidal-function-call-face. 

`((apply function: (variable) @tidal-function-call-face
        argument: (_)))

Two of the key elements of Tidal are string pattern, which encapsulate the mini-notation language, and numbers which often ar parameter of the output audio generation. It's important to me to define a specific face for them : 

`((literal (_)) @tidal-pattern-face)

All these queries have to be wrapped up as a treesit-font-lock-settings through the call to treesit-font-lock-rules. Others future are a copy from the haskell-ts-font-lock variable which match and fontify haskell code. It may conflicts nevertheless with my tidal queries. 

(defvar tidal-ts-font-lock
(treesit-font-lock-rules
 :language 'haskell
 :feature 'tidal-hush
 `(((top_splice (variable) @tidal-hush-face) (:match "hush" @tidal-hush-face)))
 :language 'haskell
 :feature 'tidal-runner
 `((top_splice
   (infix left_operand: (_) @tidal-runner-face 
            operator: (_))))
 :language 'haskell
 :feature 'tidal-function
 `((apply function: (variable) @tidal-function-call-face
        argument: (_)))
 :language 'haskell
 :feature 'tidal-pattern
 `((literal (_)) @tidal-pattern-face)
 :language 'haskell
 :feature 'keyword
 `(["module" "import" "data" "let" "where" "case" "type"
    "if" "then" "else" "of" "do" "in" "instance" "class"]
   @font-lock-keyword-face)
 :language 'haskell
 :feature 'otherwise
 :override t
 `(((match (guards guard: (boolean (variable) @font-lock-keyword-face)))
    (:match "otherwise" @font-lock-keyword-face)))
 :language 'haskell
 :feature 'type-sig
 "(signature (binding_list (variable) @font-lock-doc-markup-face))
  (signature (variable) @font-lock-doc-markup-face)"
 :language 'haskell
 :feature 'args
 :override 'keep
 (concat
  "(function (infix left_operand: (_) @haskell-ts--fontify-arg))"
  "(function (infix right_operand: (_) @haskell-ts--fontify-arg))"
  "(generator . (_) @haskell-ts--fontify-arg)"
  "(bind (as (variable) . (_) @haskell-ts--fontify-arg))"
  "(patterns) @haskell-ts--fontify-arg")
 :language 'haskell
 :feature 'type
 `((type) @font-lock-type-face
   (constructor) @font-lock-type-face)
 :language 'haskell
 :override t
 :feature 'signature
 `((signature (function) @haskell-ts--fontify-type)
   (context (function) @haskell-ts--fontify-type))
 :language 'haskell
 :feature 'match
 `((match ("|" @font-lock-doc-face) ("=" @font-lock-doc-face))
   (list_comprehension ("|" @font-lock-doc-face
                          (qualifiers (generator "<-" @font-lock-doc-face))))
   (match ("->" @font-lock-doc-face)))
 :language 'haskell
 :feature 'comment
 `(((comment) @font-lock-comment-face)
   ((haddock) @font-lock-doc-face))
 :language 'haskell
 :feature 'pragma
 `((pragma) @font-lock-preprocessor-face
   (cpp) @font-lock-preprocessor-face)
 :language 'haskell
 :feature 'str
 :override t
 `(
   (quasiquote (quoter) @font-lock-type-face)
   (quasiquote (quasiquote_body) @font-lock-preprocessor-face))
 :language 'haskell
 :feature 'parens
 :override t
 `(["(" ")" "[" "]"] @font-lock-operator-face
   (infix operator: (_) @nano-salient))
 :language 'haskell
 :feature 'function
 :override t
 `((function name: (variable) @font-lock-function-name-face)
   (function (infix (operator)  @font-lock-function-name-face))
   (declarations (type_synomym (name) @font-lock-function-name-face))
   (bind (variable) @font-lock-function-name-face)
   (function (infix (infix_id (variable) @font-lock-function-name-face)))
   (bind (as (variable) @font-lock-function-name-face))))

It remains to include this variable in the tidal mode definition. 

(setq-local treesit-font-lock-settings tidal-ts-font-lock)
(setq-local treesit-font-lock-feature-list
              tidal-ts-font-lock-feature-list)

The tidal-ts-font-lock-feaure-list insert beautifull utf-8 characters instead of some sequences of that.

3.2. Motion in tidal-mode

As we have a tree representing the tidal program we can also define some taylored motion at the buffer level or at the pattern level

3.2.1. Within a buffer

Emacs offers imenu as a way to find major definition of a file. There are extension beautifying how it presents those definition, i use consult. Treesitter offers an integration with imenu. For this, one need to append entries in treesit-simple-imenu-settings, whose format is defined in its help. 

(setq-local treesit-simple-imenu-settings
              (append treesit-simple-imenu-settings
                      `(("Runner..."  tidal-ts-imenu-runner-node-p nil ,(tidal-ts-imenu-name-function #'tidal-ts-imenu-runner-node-p)))
                      ))

Imenu needs a function to decide if a given node is a major definition, in our case to pattern match an infix or a variable with a topsplice parent. 

(defun tidal-ts-imenu-runner-node-p (node)
  (and (string-match-p "infix\\|variable" (treesit-node-type node))
       (string= (treesit-node-type (treesit-node-parent node)) "top_splice")))

The last entries is a function (actually a macro) which returns the node's text. I have no cue on why it's required to check once again if the node is a major definition, but not doing so results in imenu displaying too many nodes. 

(defmacro tidal-ts-imenu-name-function (check-func)
`(lambda (node)
   (if (funcall ,check-func node)
         (treesit-node-text node)
     nil)))

3.2.2. Within a pattern

Consider the pattern below : 

d9 $ stack [
  s "909*<3 1> ~!3 ~!2 909 ~" # lpf 400,
  every 3 (rev) $ s "808oh!4 808oh*<3 5> 808oh!<3 4>" # hpf (sine*200 + 800) # gain "1.1",
  ((1/8) ~>) $ s "bass*2 ~!3 bass ~ bass ~" # n "3 1" # legato 1,
  s "[~!<1 2> sd]!2 [~ sd*<1 2>]!2"  # legato 1]

Let the point (ie: cursor) be at d of d9. If i want to jump to the bass line, i'll need to type 4 times ↓ (or `C-u 4 ↓` then arrown down), that is one more than necessary due to the hats pattern being on two line. It would be nice to navigate throught the stack list parameter in a way or another. given a pattern p, assuming that the line where p is not truncated we mays adresse each parameter using one ↓.

For performance, i find this a little bit frustrating, especially since treesit offers us the parsing tree. The elisp api offers an interesting function, treesit-searc-forward-goto. 

treesit-search-forward-goto is a native-compiled Lisp function in
‘treesit.el’.

(treesit-search-forward-goto NODE PREDICATE &optional START BACKWARD
ALL)

Search forward for a node and move to its end position.

Stop at the first node after NODE that matches PREDICATE.
PREDICATE can be either a regexp that matches against each node’s
type case-insensitively, or a function that takes a node and
returns nil/non-nil for match/no match.

If a node matches, move to that node and return the node,
otherwise return nil.  If START is non-nil, stop at the
beginning rather than the end of a node.

This function guarantees that the matched node it returns makes
progress in terms of buffer position: the start/end position of
the returned node is always STRICTLY greater/less than that of
NODE.

BACKWARD and ALL are the same as in ‘treesit-search-forward’.

  Other relevant functions are documented in the treesit group.

[back]

For the moment, I find it easier to navigate within a model by switching from one operator to another. It also the advantage , thanks to the nature of tidal, to use a simple predicate "operator". So , i propose the interactive tidal-ts-forward-operator, universally prexifed by a number to jump to the nth operator : 

(defun tidal-ts-forward-operator (n)
  (interactive "p")
  (dotimes (c (or n 1))
    (treesit-search-forward-goto (treesit-node-at (point)) "operator") c))

Its dual navigate backward 

(defun tidal-ts-forward-operator (n)
  (interactive "p")
  (dotimes (c (or n 1))
    (treesit-search-forward-goto (treesit-node-at (point)) "operator") c))

3.3. Code

Code can be found on a Tidal fork i've made through github here.

For it to work you'll need haskell-ts-mode included in your configuration. Using use-package/straight it may be something like (prettify-symbols-mode allows you to prettiffy somes operator, such as <~ which results in ↜ 

(use-package haskell-ts-mode
:straight (haskell-ts-mode :type git :repo "https://codeberg.org/pranshu/haskell-ts-mode")
:hook
(haskell-ts-mode . prettify-symbols-mode))

One haskell-ts-mode installed and running, it's a good idea to say emacs use the haskell-ts-mode instead of haskell-mode. 

(setq major-mode-remap-alist
         '((haskell-mode . haskell-ts-mode)))

You may now install tidal 

(use-package tidal
   :straight  (tidal :type git :host github :repo "tidalcycles/Tidal" :local-repo "~/src/Tidal/" 
                    :fork (:host github  :repo "albreche/Tidal"))

The straight configuration here indicates straight that i use a fork from Tidal locally located in my ~/src/Tidal directory and hosted on my github repository. This is the place from where i updated the tidal.el mode file.

Next, follow default tidal custom variables 

:custom
(tidal-interpreter "/usr/bin/ghci")
(add-to-list 'org-babel-tangle-lang-exts '("tidal" . "tidal"))
(setq org-babel-default-header-args:tidal '((:results . "none")))
(setq org-confirm-babel-evaluate (lambda (lang body) (not (string= lang "tidal"))))
:config
 (advice-add 'tidal-start-haskell :after 'tidal-my-boot)
:after org)

I define some tidal mode-local mapping to my two simple motions function 

:bind (:map tidal-mode-map 
             ("C-M-<right>" . 'tidal-ts-forward-operator)
             ("C-M-<left>" . 'tidal-ts-backward-operator))

Finally, i set the tidal-faces described above to my favorite faces (the excellent nano faces). It suffice to inherit the tidal-x-faces with their corresponding nano-face to achieve this, which is a default emacs behavior. 

:custom-face
 (tidal-hush-face ((t (:inherit nano-popout))))
 (tidal-runner-face ((t (:inherit nano-italic))))
 (tidal-function-call-face ((t (:inherit nano-strong))))
 (tidal-pattern-face ((t (:inherit nano-critical))))

To sum up, you'll find just bellow the complete tidal configuration 

(use-package tidal
 :straight  (tidal :type git :host github :repo "tidalcycles/Tidal" :local-repo "~/src/Tidal/" 
                    :fork (:host github  :repo "albreche/Tidal"))
 :custom
 (tidal-interpreter "/usr/bin/ghci")
 (add-to-list 'org-babel-tangle-lang-exts '("tidal" . "tidal"))
 (setq org-babel-default-header-args:tidal '((:results . "none")))
 (setq org-confirm-babel-evaluate (lambda (lang body) (not (string= lang "tidal")))) 
 :bind (:map tidal-mode-map 
             ("C-M-<right>" . 'tidal-ts-forward-operator)
             ("C-M-<left>" . 'tidal-ts-backward-operator))
 :custom-face
  (tidal-hush-face ((t (:inherit nano-popout))))
  (tidal-runner-face ((t (:inherit nano-italic))))
  (tidal-function-call-face ((t (:inherit nano-strong))))
  (tidal-pattern-face ((t (:inherit nano-critical))))
:config
 (advice-add 'tidal-start-haskell :after 'tidal-my-boot)
 :after org)

Footnotes:

1

to repoduce, download the legowert sampe pack for Syrius, mkdir a Synth folder and then exec find . -iname "Synth-*" -exec mv -t Synth/ {} +. I then make a symlink from this directory to a superdirt sample directory

Created: 2024-11-17 dim. 21:14

Validate