tidal-0.9.5/ 0000755 0000000 0000000 00000000000 13212576414 011015 5 ustar 00 0000000 0000000 tidal-0.9.5/README.md 0000644 0000000 0000000 00000000561 13212576414 012276 0 ustar 00 0000000 0000000
Tidal [](https://travis-ci.org/tidalcycles/Tidal)
=====
Language for live coding of pattern
For documentation, mailing list and more info see here:
http://tidal.lurk.org/
(c) Alex McLean and contributors, 2016
Distributed under the terms of the GNU Public license version 3 (or
later).
tidal-0.9.5/tidal.el 0000644 0000000 0000000 00000040257 13212576414 012444 0 ustar 00 0000000 0000000 ;;; tidal.el --- Interact with TidalCycles for live coding patterns -*- lexical-binding: t; -*-
;; Copyright (C) 2012 alex@slab.org
;; Copyright (C) 2006-2008 rohan drape (hsc3.el)
;; Author: alex@slab.org
;; Homepage: https://github.com/tidalcycles/Tidal
;; Version: 0
;; Keywords: tools
;; Package-Requires: ((haskell-mode "16") (emacs "24"))
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see .
;;; Commentary:
;; notes from hsc3:
;; This mode is implemented as a derivation of `haskell' mode,
;; indentation and font locking is courtesy that mode. The
;; inter-process communication is courtesy `comint'. The symbol at
;; point acquisition is courtesy `thingatpt'. The directory search
;; facilities are courtesy `find-lisp'.
;;; Code:
(require 'scheme)
(require 'comint)
(require 'thingatpt)
(require 'find-lisp)
(require 'pulse)
(require 'haskell-mode)
(defvar tidal-buffer
"*tidal*"
"*The name of the tidal process buffer (default=*tidal*).")
(defvar tidal-interpreter
"ghci"
"*The haskell interpeter to use (default=ghci).")
(defvar tidal-interpreter-arguments
(list "-XOverloadedStrings"
)
"*Arguments to the haskell interpreter (default=none).")
(defvar tidal-literate-p
t
"*Flag to indicate if we are in literate mode (default=t).")
(defvar tidal-modules nil
"Additional module imports. See `tidal-run-region'.")
(make-variable-buffer-local 'tidal-literate-p)
(defun tidal-unlit (s)
"Remove bird literate marks in S."
(replace-regexp-in-string "^> " "" s))
(defun tidal-intersperse (e l)
"Insert E between every element of list L."
(when l
(cons e (cons (car l) (tidal-intersperse e (cdr l))))))
(defun tidal-start-haskell ()
"Start haskell."
(interactive)
(if (comint-check-proc tidal-buffer)
(error "A tidal process is already running")
(apply
'make-comint
"tidal"
tidal-interpreter
nil
tidal-interpreter-arguments)
(tidal-see-output))
(tidal-send-string ":set prompt \"\"")
(tidal-send-string ":set prompt2 \"\"")
(tidal-send-string ":module Sound.Tidal.Context")
(tidal-send-string "import qualified Sound.Tidal.Scales as Scales")
(tidal-send-string "import qualified Sound.Tidal.Chords as Chords")
(tidal-send-string "(cps, nudger, getNow) <- cpsUtils'")
(tidal-send-string "(d1,t1) <- superDirtSetters getNow")
(tidal-send-string "(d2,t2) <- superDirtSetters getNow")
(tidal-send-string "(d3,t3) <- superDirtSetters getNow")
(tidal-send-string "(d4,t4) <- superDirtSetters getNow")
(tidal-send-string "(d5,t5) <- superDirtSetters getNow")
(tidal-send-string "(d6,t6) <- superDirtSetters getNow")
(tidal-send-string "(d7,t7) <- superDirtSetters getNow")
(tidal-send-string "(d8,t8) <- superDirtSetters getNow")
(tidal-send-string "(d9,t9) <- superDirtSetters getNow")
(tidal-send-string "(d10,t10) <- superDirtSetters getNow")
(tidal-send-string "(c1,ct1) <- dirtSetters getNow")
(tidal-send-string "(c2,ct2) <- dirtSetters getNow")
(tidal-send-string "(c3,ct3) <- dirtSetters getNow")
(tidal-send-string "(c4,ct4) <- dirtSetters getNow")
(tidal-send-string "(c5,ct5) <- dirtSetters getNow")
(tidal-send-string "(c6,ct6) <- dirtSetters getNow")
(tidal-send-string "(c7,ct7) <- dirtSetters getNow")
(tidal-send-string "(c8,ct8) <- dirtSetters getNow")
(tidal-send-string "(c9,ct9) <- dirtSetters getNow")
(tidal-send-string "(c10,ct10) <- dirtSetters getNow")
(tidal-send-string "let bps x = cps (x/2)")
(tidal-send-string "let hush = mapM_ ($ silence) [c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,d1,d2,d3,d4,d5,d6,d7,d8,d9,d10]")
(tidal-send-string "let solo = (>>) hush")
(tidal-send-string ":set prompt \"tidal> \"")
)
(defun tidal-see-output ()
"Show haskell output."
(interactive)
(when (comint-check-proc tidal-buffer)
(delete-other-windows)
(split-window-vertically)
(with-current-buffer tidal-buffer
(let ((window (display-buffer (current-buffer))))
(goto-char (point-max))
(save-selected-window
(set-window-point window (point-max)))))))
(defun tidal-quit-haskell ()
"Quit haskell."
(interactive)
(kill-buffer tidal-buffer)
(delete-other-windows))
(defun tidal-chunk-string (n s)
"Split a string S into chunks of N characters."
(let* ((l (length s))
(m (min l n))
(c (substring s 0 m)))
(if (<= l n)
(list c)
(cons c (tidal-chunk-string n (substring s n))))))
(defun tidal-send-string (s)
(if (comint-check-proc tidal-buffer)
(let ((cs (tidal-chunk-string 64 (concat s "\n"))))
(mapcar (lambda (c) (comint-send-string tidal-buffer c)) cs))
(error "no tidal process running?")))
(defun tidal-transform-and-store (f s)
"Transform example text into compilable form."
(with-temp-file f
(mapc (lambda (module)
(insert (concat module "\n")))
tidal-modules)
(insert "main = do\n")
(insert (if tidal-literate-p (tidal-unlit s) s))))
(defun tidal-get-now ()
"Store the current cycle position in a variable called 'now'."
(interactive)
(tidal-send-string "now' <- getNow")
(tidal-send-string "let now = nextSam now'")
(tidal-send-string "let retrig = (now `rotR`)")
(tidal-send-string "let fadeOut n = spread' (_degradeBy) (retrig $ slow n $ envL)")
(tidal-send-string "let fadeIn n = spread' (_degradeBy) (retrig $ slow n $ (1-) <$> envL)")
)
(defun tidal-run-line ()
"Send the current line to the interpreter."
(interactive)
(tidal-get-now)
(let* ((s (buffer-substring (line-beginning-position)
(line-end-position)))
(s* (if tidal-literate-p
(tidal-unlit s)
s)))
(tidal-send-string s*))
(pulse-momentary-highlight-one-line (point))
(forward-line)
)
(defun tidal-eval-multiple-lines ()
"Eval the current region in the interpreter as a single line."
(tidal-get-now)
(mark-paragraph)
(let* ((s (buffer-substring-no-properties (region-beginning)
(region-end)))
(s* (if tidal-literate-p
(tidal-unlit s)
s)))
(tidal-send-string ":{")
(tidal-send-string s*)
(tidal-send-string ":}")
(mark-paragraph)
(pulse-momentary-highlight-region (mark) (point))
)
)
(defun tidal-run-multiple-lines ()
"Send the current region to the interpreter as a single line."
(interactive)
(if (>= emacs-major-version 25)
(save-mark-and-excursion
(tidal-eval-multiple-lines))
(save-excursion
(tidal-eval-multiple-lines))
)
)
(defun tidal-run-d1 ()
"Send the first instance of d1 to the interpreter as a single line."
(interactive)
(goto-char 0)
(search-forward "d1" nil nil 1)
(tidal-run-multiple-lines)
)
(defun tidal-run-d2 ()
"Send the d2 to the interpreter as a single line."
(interactive)
(goto-char 0)
(search-forward "d2" nil nil 1)
(tidal-run-multiple-lines)
)
(defun tidal-run-d3 ()
"Send the d3 to the interpreter as a single line."
(interactive)
(goto-char 0)
(search-forward "d3" nil nil 1)
(tidal-run-multiple-lines)
)
(defun tidal-run-d4 ()
"Send the d4 to the interpreter as a single line."
(interactive)
(goto-char 0)
(search-forward "d4" nil nil 1)
(tidal-run-multiple-lines)
)
(defun tidal-run-d5 ()
"Send the d5 to the interpreter as a single line."
(interactive)
(goto-char 0)
(search-forward "d5" nil nil 1)
(tidal-run-multiple-lines)
)
(defun tidal-run-d6 ()
"Send the d6 to the interpreter as a single line."
(interactive)
(goto-char 0)
(search-forward "d6" nil nil 1)
(tidal-run-multiple-lines)
)
(defun tidal-run-d7 ()
"Send the d7 to the interpreter as a single line."
(interactive)
(goto-char 0)
(search-forward "d7" nil nil 1)
(tidal-run-multiple-lines)
)
(defun tidal-run-d8 ()
"Send the d9 to the interpreter as a single line."
(interactive)
(goto-char 0)
(search-forward "d8" nil nil 1)
(tidal-run-multiple-lines)
)
(defun tidal-run-d9 ()
"Send the d9 to the interpreter as a single line."
(interactive)
(goto-char 0)
(search-forward "d9" nil nil 1)
(tidal-run-multiple-lines)
)
(defun tidal-stop-d1 ()
"send d1 $ silence as a single line"
(interactive)
(tidal-send-string ":{")
(tidal-send-string " mapM_ ($ silence) [d1]")
(tidal-send-string ":}")
)
(defun tidal-stop-d2 ()
"send d1 $ silence as a single line"
(interactive)
(tidal-send-string ":{")
(tidal-send-string " mapM_ ($ silence) [d2]")
(tidal-send-string ":}")
)
(defun tidal-stop-d3 ()
"send d1 $ silence as a single line"
(interactive)
(tidal-send-string ":{")
(tidal-send-string " mapM_ ($ silence) [d3]")
(tidal-send-string ":}")
)
(defun tidal-stop-d4 ()
"send d1 $ silence as a single line"
(interactive)
(tidal-send-string ":{")
(tidal-send-string " mapM_ ($ silence) [d4]")
(tidal-send-string ":}")
)
(defun tidal-stop-d5 ()
"send d1 $ silence as a single line"
(interactive)
(tidal-send-string ":{")
(tidal-send-string " mapM_ ($ silence) [d5]")
(tidal-send-string ":}")
)
(defun tidal-stop-d6 ()
"send d1 $ silence as a single line"
(interactive)
(tidal-send-string ":{")
(tidal-send-string " mapM_ ($ silence) [d6]")
(tidal-send-string ":}")
)
(defun tidal-stop-d7 ()
"send d1 $ silence as a single line"
(interactive)
(tidal-send-string ":{")
(tidal-send-string " mapM_ ($ silence) [d7]")
(tidal-send-string ":}")
)
(defun tidal-stop-d8 ()
"send d1 $ silence as a single line"
(interactive)
(tidal-send-string ":{")
(tidal-send-string " mapM_ ($ silence) [d8]")
(tidal-send-string ":}")
)
(defun tidal-stop-d9 ()
"send d1 $ silence as a single line"
(interactive)
(tidal-send-string ":{")
(tidal-send-string " mapM_ ($ silence) [d9]")
(tidal-send-string ":}")
)
(defun tidal-run-region ()
"Place the region in a do block and compile."
(interactive)
(tidal-transform-and-store
"/tmp/tidal.hs"
(buffer-substring-no-properties (region-beginning) (region-end)))
(tidal-send-string ":load \"/tmp/tidal.hs\"")
(tidal-send-string "main"))
(defun tidal-load-buffer ()
"Load the current buffer."
(interactive)
(save-buffer)
(tidal-send-string (format ":load \"%s\"" buffer-file-name)))
(defun tidal-run-main ()
"Run current main."
(interactive)
(tidal-send-string "main"))
(defun tidal-interrupt-haskell ()
(interactive)
(if (comint-check-proc tidal-buffer)
(with-current-buffer tidal-buffer
(interrupt-process (get-buffer-process (current-buffer))))
(error "no tidal process running?")))
(defvar tidal-mode-map nil
"Tidal keymap.")
(defun tidal-mode-keybindings (map)
"Haskell Tidal keybindings."
(define-key map [?\C-c ?\C-s] 'tidal-start-haskell)
(define-key map [?\C-c ?\C-v] 'tidal-see-output)
(define-key map [?\C-c ?\C-q] 'tidal-quit-haskell)
(define-key map [?\C-c ?\C-c] 'tidal-run-line)
(define-key map [?\C-c ?\C-e] 'tidal-run-multiple-lines)
(define-key map (kbd "") 'tidal-run-multiple-lines)
(define-key map [?\C-c ?\C-r] 'tidal-run-region)
(define-key map [?\C-c ?\C-l] 'tidal-load-buffer)
(define-key map [?\C-c ?\C-i] 'tidal-interrupt-haskell)
(define-key map [?\C-c ?\C-m] 'tidal-run-main)
(define-key map [?\C-c ?\C-1] 'tidal-run-d1)
(define-key map [?\C-c ?\C-2] 'tidal-run-d2)
(define-key map [?\C-c ?\C-3] 'tidal-run-d3)
(define-key map [?\C-c ?\C-4] 'tidal-run-d4)
(define-key map [?\C-c ?\C-5] 'tidal-run-d5)
(define-key map [?\C-c ?\C-6] 'tidal-run-d6)
(define-key map [?\C-c ?\C-7] 'tidal-run-d7)
(define-key map [?\C-c ?\C-8] 'tidal-run-d8)
(define-key map [?\C-c ?\C-9] 'tidal-run-d9)
(define-key map [?\C-v ?\C-1] 'tidal-stop-d1)
(define-key map [?\C-v ?\C-2] 'tidal-stop-d2)
(define-key map [?\C-v ?\C-3] 'tidal-stop-d3)
(define-key map [?\C-v ?\C-4] 'tidal-stop-d4)
(define-key map [?\C-v ?\C-5] 'tidal-stop-d5)
(define-key map [?\C-v ?\C-6] 'tidal-stop-d6)
(define-key map [?\C-v ?\C-7] 'tidal-stop-d7)
(define-key map [?\C-v ?\C-8] 'tidal-stop-d8)
(define-key map [?\C-v ?\C-9] 'tidal-stop-d9))
(defun turn-on-tidal-keybindings ()
"Haskell Tidal keybindings in the local map."
(local-set-key [?\C-c ?\C-s] 'tidal-start-haskell)
(local-set-key [?\C-c ?\C-v] 'tidal-see-output)
(local-set-key [?\C-c ?\C-q] 'tidal-quit-haskell)
(local-set-key [?\C-c ?\C-c] 'tidal-run-line)
(local-set-key [?\C-c ?\C-e] 'tidal-run-multiple-lines)
(local-set-key (kbd "") 'tidal-run-multiple-lines)
(local-set-key [?\C-c ?\C-r] 'tidal-run-region)
(local-set-key [?\C-c ?\C-l] 'tidal-load-buffer)
(local-set-key [?\C-c ?\C-i] 'tidal-interrupt-haskell)
(local-set-key [?\C-c ?\C-m] 'tidal-run-main)
(local-set-key [?\C-c ?\C-1] 'tidal-run-d1)
(local-set-key [?\C-c ?\C-2] 'tidal-run-d2)
(local-set-key [?\C-c ?\C-3] 'tidal-run-d3)
(local-set-key [?\C-c ?\C-4] 'tidal-run-d4)
(local-set-key [?\C-c ?\C-5] 'tidal-run-d5)
(local-set-key [?\C-c ?\C-6] 'tidal-run-d6)
(local-set-key [?\C-c ?\C-7] 'tidal-run-d7)
(local-set-key [?\C-c ?\C-8] 'tidal-run-d8)
(local-set-key [?\C-c ?\C-9] 'tidal-run-d9)
(local-set-key [?\C-v ?\C-1] 'tidal-stop-d1)
(local-set-key [?\C-v ?\C-2] 'tidal-stop-d2)
(local-set-key [?\C-v ?\C-3] 'tidal-stop-d3)
(local-set-key [?\C-v ?\C-4] 'tidal-stop-d4)
(local-set-key [?\C-v ?\C-5] 'tidal-stop-d5)
(local-set-key [?\C-v ?\C-6] 'tidal-stop-d6)
(local-set-key [?\C-v ?\C-7] 'tidal-stop-d7)
(local-set-key [?\C-v ?\C-8] 'tidal-stop-d8)
(local-set-key [?\C-v ?\C-9] 'tidal-stop-d9))
(defun tidal-mode-menu (map)
"Haskell Tidal menu."
(define-key map [menu-bar tidal]
(cons "Haskell-Tidal" (make-sparse-keymap "Haskell-Tidal")))
(define-key map [menu-bar tidal help]
(cons "Help" (make-sparse-keymap "Help")))
(define-key map [menu-bar tidal expression]
(cons "Expression" (make-sparse-keymap "Expression")))
(define-key map [menu-bar tidal expression load-buffer]
'("Load buffer" . tidal-load-buffer))
(define-key map [menu-bar tidal expression run-main]
'("Run main" . tidal-run-main))
(define-key map [menu-bar tidal expression run-region]
'("Run region" . tidal-run-region))
(define-key map [menu-bar tidal expression run-multiple-lines]
'("Run multiple lines" . tidal-run-multiple-lines))
(define-key map [menu-bar tidal expression run-line]
'("Run line" . tidal-run-line))
(define-key map [menu-bar tidal haskell]
(cons "Haskell" (make-sparse-keymap "Haskell")))
(define-key map [menu-bar tidal haskell quit-haskell]
'("Quit haskell" . tidal-quit-haskell))
(define-key map [menu-bar tidal haskell see-output]
'("See output" . tidal-see-output))
(define-key map [menu-bar tidal haskell start-haskell]
'("Start haskell" . tidal-start-haskell)))
(unless tidal-mode-map
(let ((map (make-sparse-keymap "Haskell-Tidal")))
(tidal-mode-keybindings map)
(tidal-mode-menu map)
(setq tidal-mode-map map)))
;;;###autoload
(define-derived-mode
literate-tidal-mode
tidal-mode
"Literate Haskell Tidal"
"Major mode for interacting with an inferior haskell process."
(set (make-local-variable 'paragraph-start) "\f\\|[ \t]*$")
(set (make-local-variable 'paragraph-separate) "[ \t\f]*$")
(setq tidal-literate-p t)
(setq haskell-literate 'bird)
(turn-on-font-lock))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.ltidal$" . literate-tidal-mode))
;;(add-to-list 'load-path "/usr/share/emacs/site-lisp/haskell-mode/") ;required by olig1905 on linux
;;(require 'haskell-mode) ;required by olig1905 on linux
;;;###autoload
(define-derived-mode
tidal-mode
haskell-mode
"Haskell Tidal"
"Major mode for interacting with an inferior haskell process."
(set (make-local-variable 'paragraph-start) "\f\\|[ \t]*$")
(set (make-local-variable 'paragraph-separate) "[ \t\f]*$")
(setq tidal-literate-p nil)
(turn-on-font-lock))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.tidal$" . tidal-mode))
(provide 'tidal)
;;; tidal.el ends here
tidal-0.9.5/CHANGELOG.md 0000644 0000000 0000000 00000003612 13212576414 012630 0 ustar 00 0000000 0000000 # TidalCycles log of changes
## 0.9.5
### Enhancements
* Added `hurry` which both speeds up the sound and the pattern by the given amount.
* Added `stripe` which repeats a pattern a given number of times per
cycle, with random but contiguous durations.
* Added continuous function `cosine`
* Turned more pattern transformation parameters into patterns - spread', striateX, every', inside, outside, swing
* Added experimental datatype for Xenakis sieves
* Correctly parse negative rationals
* Added `breakUp` that finds events that share the same timespan, and spreads them out during that timespan, so for example (breakUp "[bd,sn]") gets turned into the "bd sn"
* Added `fill` which 'fills in' gaps in one pattern with events from another.
## 0.9.4
### Fixes
* Swapped `-` for `..` in ranges as quick fix for issue with parsing negative numbers
* Removed overloaded list thingie for now, unsure whether it's worth the dependency
## 0.9.3
### Enhancements
* The sequence parser can now expand ranges, e.g. `"0-3 4-2"` is
equivalent to `"[0 1 2 3] [4 3 2]"`
* Sequences can now be described using list syntax, for example `sound ["bd", "sn"]` is equivalent to `sound "bd sn"`. They *aren't* lists though, so you can't for example do `sound (["bd", "sn"] ++ ["arpy", "cp"])` -- but can do `sound (append ["bd", "sn"] ["arpy", "cp"])`
* New function `linger`, e.g. `linger (1/4)` will only play the first quarter of the given pattern, four times to fill the cycle.
* `discretise` now takes time value as its first parameter, not a pattern of time, which was causing problems and needs some careful thought.
* a `rel` alias for the `release` parameter, to match the `att` alias for `attack`
* `_fast` alias for `_density`
* The start of automatic testing for a holy bug-free future
### Fixes
* Fixed bug that was causing events to double up or get lost,
e.g. where `rev` was combined with certain other functions.
tidal-0.9.5/LICENSE 0000644 0000000 0000000 00000104446 13212576414 012033 0 ustar 00 0000000 0000000 GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
Copyright (C) 2007 Free Software Foundation, Inc.
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The GNU General Public License is a free, copyleft license for
software and other kinds of works.
The licenses for most software and other practical works are designed
to take away your freedom to share and change the works. By contrast,
the GNU General Public License is intended to guarantee your freedom to
share and change all versions of a program--to make sure it remains free
software for all its users. We, the Free Software Foundation, use the
GNU General Public License for most of our software; it applies also to
any other work released this way by its authors. You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
them if you wish), that you receive source code or can get it if you
want it, that you can change the software or use pieces of it in new
free programs, and that you know you can do these things.
To protect your rights, we need to prevent others from denying you
these rights or asking you to surrender the rights. Therefore, you have
certain responsibilities if you distribute copies of the software, or if
you modify it: responsibilities to respect the freedom of others.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must pass on to the recipients the same
freedoms that you received. You must make sure that they, too, receive
or can get the source code. And you must show them these terms so they
know their rights.
Developers that use the GNU GPL protect your rights with two steps:
(1) assert copyright on the software, and (2) offer you this License
giving you legal permission to copy, distribute and/or modify it.
For the developers' and authors' protection, the GPL clearly explains
that there is no warranty for this free software. For both users' and
authors' sake, the GPL requires that modified versions be marked as
changed, so that their problems will not be attributed erroneously to
authors of previous versions.
Some devices are designed to deny users access to install or run
modified versions of the software inside them, although the manufacturer
can do so. This is fundamentally incompatible with the aim of
protecting users' freedom to change the software. The systematic
pattern of such abuse occurs in the area of products for individuals to
use, which is precisely where it is most unacceptable. Therefore, we
have designed this version of the GPL to prohibit the practice for those
products. If such problems arise substantially in other domains, we
stand ready to extend this provision to those domains in future versions
of the GPL, as needed to protect the freedom of users.
Finally, every program is threatened constantly by software patents.
States should not allow patents to restrict development and use of
software on general-purpose computers, but in those that do, we wish to
avoid the special danger that patents applied to a free program could
make it effectively proprietary. To prevent this, the GPL assures that
patents cannot be used to render the program non-free.
The precise terms and conditions for copying, distribution and
modification follow.
TERMS AND CONDITIONS
0. Definitions.
"This License" refers to version 3 of the GNU General Public License.
"Copyright" also means copyright-like laws that apply to other kinds of
works, such as semiconductor masks.
"The Program" refers to any copyrightable work licensed under this
License. Each licensee is addressed as "you". "Licensees" and
"recipients" may be individuals or organizations.
To "modify" a work means to copy from or adapt all or part of the work
in a fashion requiring copyright permission, other than the making of an
exact copy. The resulting work is called a "modified version" of the
earlier work or a work "based on" the earlier work.
A "covered work" means either the unmodified Program or a work based
on the Program.
To "propagate" a work means to do anything with it that, without
permission, would make you directly or secondarily liable for
infringement under applicable copyright law, except executing it on a
computer or modifying a private copy. Propagation includes copying,
distribution (with or without modification), making available to the
public, and in some countries other activities as well.
To "convey" a work means any kind of propagation that enables other
parties to make or receive copies. Mere interaction with a user through
a computer network, with no transfer of a copy, is not conveying.
An interactive user interface displays "Appropriate Legal Notices"
to the extent that it includes a convenient and prominently visible
feature that (1) displays an appropriate copyright notice, and (2)
tells the user that there is no warranty for the work (except to the
extent that warranties are provided), that licensees may convey the
work under this License, and how to view a copy of this License. If
the interface presents a list of user commands or options, such as a
menu, a prominent item in the list meets this criterion.
1. Source Code.
The "source code" for a work means the preferred form of the work
for making modifications to it. "Object code" means any non-source
form of a work.
A "Standard Interface" means an interface that either is an official
standard defined by a recognized standards body, or, in the case of
interfaces specified for a particular programming language, one that
is widely used among developers working in that language.
The "System Libraries" of an executable work include anything, other
than the work as a whole, that (a) is included in the normal form of
packaging a Major Component, but which is not part of that Major
Component, and (b) serves only to enable use of the work with that
Major Component, or to implement a Standard Interface for which an
implementation is available to the public in source code form. A
"Major Component", in this context, means a major essential component
(kernel, window system, and so on) of the specific operating system
(if any) on which the executable work runs, or a compiler used to
produce the work, or an object code interpreter used to run it.
The "Corresponding Source" for a work in object code form means all
the source code needed to generate, install, and (for an executable
work) run the object code and to modify the work, including scripts to
control those activities. However, it does not include the work's
System Libraries, or general-purpose tools or generally available free
programs which are used unmodified in performing those activities but
which are not part of the work. For example, Corresponding Source
includes interface definition files associated with source files for
the work, and the source code for shared libraries and dynamically
linked subprograms that the work is specifically designed to require,
such as by intimate data communication or control flow between those
subprograms and other parts of the work.
The Corresponding Source need not include anything that users
can regenerate automatically from other parts of the Corresponding
Source.
The Corresponding Source for a work in source code form is that
same work.
2. Basic Permissions.
All rights granted under this License are granted for the term of
copyright on the Program, and are irrevocable provided the stated
conditions are met. This License explicitly affirms your unlimited
permission to run the unmodified Program. The output from running a
covered work is covered by this License only if the output, given its
content, constitutes a covered work. This License acknowledges your
rights of fair use or other equivalent, as provided by copyright law.
You may make, run and propagate covered works that you do not
convey, without conditions so long as your license otherwise remains
in force. You may convey covered works to others for the sole purpose
of having them make modifications exclusively for you, or provide you
with facilities for running those works, provided that you comply with
the terms of this License in conveying all material for which you do
not control copyright. Those thus making or running the covered works
for you must do so exclusively on your behalf, under your direction
and control, on terms that prohibit them from making any copies of
your copyrighted material outside their relationship with you.
Conveying under any other circumstances is permitted solely under
the conditions stated below. Sublicensing is not allowed; section 10
makes it unnecessary.
3. Protecting Users' Legal Rights From Anti-Circumvention Law.
No covered work shall be deemed part of an effective technological
measure under any applicable law fulfilling obligations under article
11 of the WIPO copyright treaty adopted on 20 December 1996, or
similar laws prohibiting or restricting circumvention of such
measures.
When you convey a covered work, you waive any legal power to forbid
circumvention of technological measures to the extent such circumvention
is effected by exercising rights under this License with respect to
the covered work, and you disclaim any intention to limit operation or
modification of the work as a means of enforcing, against the work's
users, your or third parties' legal rights to forbid circumvention of
technological measures.
4. Conveying Verbatim Copies.
You may convey verbatim copies of the Program's source code as you
receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice;
keep intact all notices stating that this License and any
non-permissive terms added in accord with section 7 apply to the code;
keep intact all notices of the absence of any warranty; and give all
recipients a copy of this License along with the Program.
You may charge any price or no price for each copy that you convey,
and you may offer support or warranty protection for a fee.
5. Conveying Modified Source Versions.
You may convey a work based on the Program, or the modifications to
produce it from the Program, in the form of source code under the
terms of section 4, provided that you also meet all of these conditions:
a) The work must carry prominent notices stating that you modified
it, and giving a relevant date.
b) The work must carry prominent notices stating that it is
released under this License and any conditions added under section
7. This requirement modifies the requirement in section 4 to
"keep intact all notices".
c) You must license the entire work, as a whole, under this
License to anyone who comes into possession of a copy. This
License will therefore apply, along with any applicable section 7
additional terms, to the whole of the work, and all its parts,
regardless of how they are packaged. This License gives no
permission to license the work in any other way, but it does not
invalidate such permission if you have separately received it.
d) If the work has interactive user interfaces, each must display
Appropriate Legal Notices; however, if the Program has interactive
interfaces that do not display Appropriate Legal Notices, your
work need not make them do so.
A compilation of a covered work with other separate and independent
works, which are not by their nature extensions of the covered work,
and which are not combined with it such as to form a larger program,
in or on a volume of a storage or distribution medium, is called an
"aggregate" if the compilation and its resulting copyright are not
used to limit the access or legal rights of the compilation's users
beyond what the individual works permit. Inclusion of a covered work
in an aggregate does not cause this License to apply to the other
parts of the aggregate.
6. Conveying Non-Source Forms.
You may convey a covered work in object code form under the terms
of sections 4 and 5, provided that you also convey the
machine-readable Corresponding Source under the terms of this License,
in one of these ways:
a) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by the
Corresponding Source fixed on a durable physical medium
customarily used for software interchange.
b) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by a
written offer, valid for at least three years and valid for as
long as you offer spare parts or customer support for that product
model, to give anyone who possesses the object code either (1) a
copy of the Corresponding Source for all the software in the
product that is covered by this License, on a durable physical
medium customarily used for software interchange, for a price no
more than your reasonable cost of physically performing this
conveying of source, or (2) access to copy the
Corresponding Source from a network server at no charge.
c) Convey individual copies of the object code with a copy of the
written offer to provide the Corresponding Source. This
alternative is allowed only occasionally and noncommercially, and
only if you received the object code with such an offer, in accord
with subsection 6b.
d) Convey the object code by offering access from a designated
place (gratis or for a charge), and offer equivalent access to the
Corresponding Source in the same way through the same place at no
further charge. You need not require recipients to copy the
Corresponding Source along with the object code. If the place to
copy the object code is a network server, the Corresponding Source
may be on a different server (operated by you or a third party)
that supports equivalent copying facilities, provided you maintain
clear directions next to the object code saying where to find the
Corresponding Source. Regardless of what server hosts the
Corresponding Source, you remain obligated to ensure that it is
available for as long as needed to satisfy these requirements.
e) Convey the object code using peer-to-peer transmission, provided
you inform other peers where the object code and Corresponding
Source of the work are being offered to the general public at no
charge under subsection 6d.
A separable portion of the object code, whose source code is excluded
from the Corresponding Source as a System Library, need not be
included in conveying the object code work.
A "User Product" is either (1) a "consumer product", which means any
tangible personal property which is normally used for personal, family,
or household purposes, or (2) anything designed or sold for incorporation
into a dwelling. In determining whether a product is a consumer product,
doubtful cases shall be resolved in favor of coverage. For a particular
product received by a particular user, "normally used" refers to a
typical or common use of that class of product, regardless of the status
of the particular user or of the way in which the particular user
actually uses, or expects or is expected to use, the product. A product
is a consumer product regardless of whether the product has substantial
commercial, industrial or non-consumer uses, unless such uses represent
the only significant mode of use of the product.
"Installation Information" for a User Product means any methods,
procedures, authorization keys, or other information required to install
and execute modified versions of a covered work in that User Product from
a modified version of its Corresponding Source. The information must
suffice to ensure that the continued functioning of the modified object
code is in no case prevented or interfered with solely because
modification has been made.
If you convey an object code work under this section in, or with, or
specifically for use in, a User Product, and the conveying occurs as
part of a transaction in which the right of possession and use of the
User Product is transferred to the recipient in perpetuity or for a
fixed term (regardless of how the transaction is characterized), the
Corresponding Source conveyed under this section must be accompanied
by the Installation Information. But this requirement does not apply
if neither you nor any third party retains the ability to install
modified object code on the User Product (for example, the work has
been installed in ROM).
The requirement to provide Installation Information does not include a
requirement to continue to provide support service, warranty, or updates
for a work that has been modified or installed by the recipient, or for
the User Product in which it has been modified or installed. Access to a
network may be denied when the modification itself materially and
adversely affects the operation of the network or violates the rules and
protocols for communication across the network.
Corresponding Source conveyed, and Installation Information provided,
in accord with this section must be in a format that is publicly
documented (and with an implementation available to the public in
source code form), and must require no special password or key for
unpacking, reading or copying.
7. Additional Terms.
"Additional permissions" are terms that supplement the terms of this
License by making exceptions from one or more of its conditions.
Additional permissions that are applicable to the entire Program shall
be treated as though they were included in this License, to the extent
that they are valid under applicable law. If additional permissions
apply only to part of the Program, that part may be used separately
under those permissions, but the entire Program remains governed by
this License without regard to the additional permissions.
When you convey a copy of a covered work, you may at your option
remove any additional permissions from that copy, or from any part of
it. (Additional permissions may be written to require their own
removal in certain cases when you modify the work.) You may place
additional permissions on material, added by you to a covered work,
for which you have or can give appropriate copyright permission.
Notwithstanding any other provision of this License, for material you
add to a covered work, you may (if authorized by the copyright holders of
that material) supplement the terms of this License with terms:
a) Disclaiming warranty or limiting liability differently from the
terms of sections 15 and 16 of this License; or
b) Requiring preservation of specified reasonable legal notices or
author attributions in that material or in the Appropriate Legal
Notices displayed by works containing it; or
c) Prohibiting misrepresentation of the origin of that material, or
requiring that modified versions of such material be marked in
reasonable ways as different from the original version; or
d) Limiting the use for publicity purposes of names of licensors or
authors of the material; or
e) Declining to grant rights under trademark law for use of some
trade names, trademarks, or service marks; or
f) Requiring indemnification of licensors and authors of that
material by anyone who conveys the material (or modified versions of
it) with contractual assumptions of liability to the recipient, for
any liability that these contractual assumptions directly impose on
those licensors and authors.
All other non-permissive additional terms are considered "further
restrictions" within the meaning of section 10. If the Program as you
received it, or any part of it, contains a notice stating that it is
governed by this License along with a term that is a further
restriction, you may remove that term. If a license document contains
a further restriction but permits relicensing or conveying under this
License, you may add to a covered work material governed by the terms
of that license document, provided that the further restriction does
not survive such relicensing or conveying.
If you add terms to a covered work in accord with this section, you
must place, in the relevant source files, a statement of the
additional terms that apply to those files, or a notice indicating
where to find the applicable terms.
Additional terms, permissive or non-permissive, may be stated in the
form of a separately written license, or stated as exceptions;
the above requirements apply either way.
8. Termination.
You may not propagate or modify a covered work except as expressly
provided under this License. Any attempt otherwise to propagate or
modify it is void, and will automatically terminate your rights under
this License (including any patent licenses granted under the third
paragraph of section 11).
However, if you cease all violation of this License, then your
license from a particular copyright holder is reinstated (a)
provisionally, unless and until the copyright holder explicitly and
finally terminates your license, and (b) permanently, if the copyright
holder fails to notify you of the violation by some reasonable means
prior to 60 days after the cessation.
Moreover, your license from a particular copyright holder is
reinstated permanently if the copyright holder notifies you of the
violation by some reasonable means, this is the first time you have
received notice of violation of this License (for any work) from that
copyright holder, and you cure the violation prior to 30 days after
your receipt of the notice.
Termination of your rights under this section does not terminate the
licenses of parties who have received copies or rights from you under
this License. If your rights have been terminated and not permanently
reinstated, you do not qualify to receive new licenses for the same
material under section 10.
9. Acceptance Not Required for Having Copies.
You are not required to accept this License in order to receive or
run a copy of the Program. Ancillary propagation of a covered work
occurring solely as a consequence of using peer-to-peer transmission
to receive a copy likewise does not require acceptance. However,
nothing other than this License grants you permission to propagate or
modify any covered work. These actions infringe copyright if you do
not accept this License. Therefore, by modifying or propagating a
covered work, you indicate your acceptance of this License to do so.
10. Automatic Licensing of Downstream Recipients.
Each time you convey a covered work, the recipient automatically
receives a license from the original licensors, to run, modify and
propagate that work, subject to this License. You are not responsible
for enforcing compliance by third parties with this License.
An "entity transaction" is a transaction transferring control of an
organization, or substantially all assets of one, or subdividing an
organization, or merging organizations. If propagation of a covered
work results from an entity transaction, each party to that
transaction who receives a copy of the work also receives whatever
licenses to the work the party's predecessor in interest had or could
give under the previous paragraph, plus a right to possession of the
Corresponding Source of the work from the predecessor in interest, if
the predecessor has it or can get it with reasonable efforts.
You may not impose any further restrictions on the exercise of the
rights granted or affirmed under this License. For example, you may
not impose a license fee, royalty, or other charge for exercise of
rights granted under this License, and you may not initiate litigation
(including a cross-claim or counterclaim in a lawsuit) alleging that
any patent claim is infringed by making, using, selling, offering for
sale, or importing the Program or any portion of it.
11. Patents.
A "contributor" is a copyright holder who authorizes use under this
License of the Program or a work on which the Program is based. The
work thus licensed is called the contributor's "contributor version".
A contributor's "essential patent claims" are all patent claims
owned or controlled by the contributor, whether already acquired or
hereafter acquired, that would be infringed by some manner, permitted
by this License, of making, using, or selling its contributor version,
but do not include claims that would be infringed only as a
consequence of further modification of the contributor version. For
purposes of this definition, "control" includes the right to grant
patent sublicenses in a manner consistent with the requirements of
this License.
Each contributor grants you a non-exclusive, worldwide, royalty-free
patent license under the contributor's essential patent claims, to
make, use, sell, offer for sale, import and otherwise run, modify and
propagate the contents of its contributor version.
In the following three paragraphs, a "patent license" is any express
agreement or commitment, however denominated, not to enforce a patent
(such as an express permission to practice a patent or covenant not to
sue for patent infringement). To "grant" such a patent license to a
party means to make such an agreement or commitment not to enforce a
patent against the party.
If you convey a covered work, knowingly relying on a patent license,
and the Corresponding Source of the work is not available for anyone
to copy, free of charge and under the terms of this License, through a
publicly available network server or other readily accessible means,
then you must either (1) cause the Corresponding Source to be so
available, or (2) arrange to deprive yourself of the benefit of the
patent license for this particular work, or (3) arrange, in a manner
consistent with the requirements of this License, to extend the patent
license to downstream recipients. "Knowingly relying" means you have
actual knowledge that, but for the patent license, your conveying the
covered work in a country, or your recipient's use of the covered work
in a country, would infringe one or more identifiable patents in that
country that you have reason to believe are valid.
If, pursuant to or in connection with a single transaction or
arrangement, you convey, or propagate by procuring conveyance of, a
covered work, and grant a patent license to some of the parties
receiving the covered work authorizing them to use, propagate, modify
or convey a specific copy of the covered work, then the patent license
you grant is automatically extended to all recipients of the covered
work and works based on it.
A patent license is "discriminatory" if it does not include within
the scope of its coverage, prohibits the exercise of, or is
conditioned on the non-exercise of one or more of the rights that are
specifically granted under this License. You may not convey a covered
work if you are a party to an arrangement with a third party that is
in the business of distributing software, under which you make payment
to the third party based on the extent of your activity of conveying
the work, and under which the third party grants, to any of the
parties who would receive the covered work from you, a discriminatory
patent license (a) in connection with copies of the covered work
conveyed by you (or copies made from those copies), or (b) primarily
for and in connection with specific products or compilations that
contain the covered work, unless you entered into that arrangement,
or that patent license was granted, prior to 28 March 2007.
Nothing in this License shall be construed as excluding or limiting
any implied license or other defenses to infringement that may
otherwise be available to you under applicable patent law.
12. No Surrender of Others' Freedom.
If conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot convey a
covered work so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you may
not convey it at all. For example, if you agree to terms that obligate you
to collect a royalty for further conveying from those to whom you convey
the Program, the only way you could satisfy both those terms and this
License would be to refrain entirely from conveying the Program.
13. Use with the GNU Affero General Public License.
Notwithstanding any other provision of this License, you have
permission to link or combine any covered work with a work licensed
under version 3 of the GNU Affero General Public License into a single
combined work, and to convey the resulting work. The terms of this
License will continue to apply to the part which is the covered work,
but the special requirements of the GNU Affero General Public License,
section 13, concerning interaction through a network will apply to the
combination as such.
14. Revised Versions of this License.
The Free Software Foundation may publish revised and/or new versions of
the GNU General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the
Program specifies that a certain numbered version of the GNU General
Public License "or any later version" applies to it, you have the
option of following the terms and conditions either of that numbered
version or of any later version published by the Free Software
Foundation. If the Program does not specify a version number of the
GNU General Public License, you may choose any version ever published
by the Free Software Foundation.
If the Program specifies that a proxy can decide which future
versions of the GNU General Public License can be used, that proxy's
public statement of acceptance of a version permanently authorizes you
to choose that version for the Program.
Later license versions may give you additional or different
permissions. However, no additional obligations are imposed on any
author or copyright holder as a result of your choosing to follow a
later version.
15. Disclaimer of Warranty.
THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
16. Limitation of Liability.
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.
17. Interpretation of Sections 15 and 16.
If the disclaimer of warranty and limitation of liability provided
above cannot be given local legal effect according to their terms,
reviewing courts shall apply local law that most closely approximates
an absolute waiver of all civil liability in connection with the
Program, unless a warranty or assumption of liability accompanies a
copy of the Program in return for a fee.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
state the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
Copyright (C)
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
Also add information on how to contact you by electronic and paper mail.
If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:
Copyright (C)
This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, your program's commands
might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
.
tidal-0.9.5/Setup.hs 0000644 0000000 0000000 00000000056 13212576414 012452 0 ustar 00 0000000 0000000 import Distribution.Simple
main = defaultMain
tidal-0.9.5/tidal.cabal 0000644 0000000 0000000 00000004162 13212576414 013101 0 ustar 00 0000000 0000000 name: tidal
version: 0.9.5
synopsis: Pattern language for improvised music
-- description:
homepage: http://tidalcycles.org/
license: GPL-3
license-file: LICENSE
author: Alex McLean
maintainer: Alex McLean , Mike Hodnick
Stability: Experimental
Copyright: (c) Tidal contributors, 2017
category: Sound
build-type: Simple
cabal-version: >=1.10
tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1
Extra-source-files: README.md CHANGELOG.md tidal.el doc/tidal.md
Description: Tidal is a domain specific language for live coding pattern.
library
default-language: Haskell2010
Exposed-modules: Sound.Tidal.Bjorklund
Sound.Tidal.Strategies
Sound.Tidal.Dirt
Sound.Tidal.Pattern
Sound.Tidal.Stream
Sound.Tidal.OscStream
Sound.Tidal.Parse
Sound.Tidal.Tempo
Sound.Tidal.Time
Sound.Tidal.Context
Sound.Tidal.Utils
Sound.Tidal.SuperCollider
Sound.Tidal.Params
Sound.Tidal.Transition
Sound.Tidal.Scales
Sound.Tidal.Chords
Sound.Tidal.Sieve
Sound.Tidal.Version
-- Sound.Tidal.PatternList
Build-depends:
base < 5
, containers
, hashable
, colour
, hosc > 0.13, hosc <= 0.15
, text
, mersenne-random-pure64
, time
, parsec
, safe
, websockets > 0.8
, mtl >= 2.1
source-repository head
type: git
location: https://github.com/tidalcycles/Tidal
test-suite test
default-language:
Haskell2010
type:
exitcode-stdio-1.0
hs-source-dirs:
tests
main-is:
test.hs
build-depends:
base >= 4 && < 5
, tasty >= 0.11
, tasty-hunit
, tidal
tidal-0.9.5/tests/ 0000755 0000000 0000000 00000000000 13212576414 012157 5 ustar 00 0000000 0000000 tidal-0.9.5/tests/test.hs 0000644 0000000 0000000 00000002150 13212576414 013470 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-}
import Test.Tasty
-- import Test.Tasty.SmallCheck as SC
-- import Test.Tasty.QuickCheck as QC
import Test.Tasty.HUnit
import Data.List
import Data.Ord
import Sound.Tidal.Context
main = defaultMain tests
tests :: TestTree
tests = testGroup "Tests" [basic1,
patternsOfPatterns
]
basic1 = testGroup "fast / slow"
[
testCase "silence" $ same16 (fast 1.1 silence) (silence :: Pattern Double),
testCase "fast" $ same16 silence (silence :: Pattern Double),
testCase "fast" $ same16 "bd*128" (rep 128 "bd")
]
patternsOfPatterns =
testGroup "patterns of patterns"
[
testCase "decimal density" $ same16 (_discretise 0.25 saw) (discretise 0.25 saw)
]
rep :: Int -> String -> Pattern String
rep n v = p $ intercalate " " $ take n $ repeat v
sameN :: (Eq a, Show a) => String -> Time -> Pattern a -> Pattern a -> Assertion
sameN s n a b = assertEqual s (arc a (0,n)) (arc b (0,n))
same16 :: (Eq a, Show a) => Pattern a -> Pattern a -> Assertion
same16 = sameN "for 16 cycles," 16
tidal-0.9.5/Sound/ 0000755 0000000 0000000 00000000000 13212576414 012105 5 ustar 00 0000000 0000000 tidal-0.9.5/Sound/Tidal/ 0000755 0000000 0000000 00000000000 13212576414 013142 5 ustar 00 0000000 0000000 tidal-0.9.5/Sound/Tidal/Scales.hs 0000644 0000000 0000000 00000006632 13212576414 014717 0 ustar 00 0000000 0000000 module Sound.Tidal.Scales where
-- five notes scales
minPent :: Num a => [a]
minPent = [0,3,5,7,10]
majPent :: Num a => [a]
majPent = [0,2,4,7,9]
-- another mode of major pentatonic
ritusen :: Num a => [a]
ritusen = [0,2,5,7,9]
-- another mode of major pentatonic
egyptian :: Num a => [a]
egyptian = [0,2,5,7,10]
--
kumai :: Num a => [a]
kumai = [0,2,3,7,9]
hirajoshi :: Num a => [a]
hirajoshi = [0,2,3,7,8]
iwato :: Num a => [a]
iwato = [0,1,5,6,10]
chinese :: Num a => [a]
chinese = [0,4,6,7,11]
indian :: Num a => [a]
indian = [0,4,5,7,10]
pelog :: Num a => [a]
pelog = [0,1,3,7,8]
--
prometheus :: Num a => [a]
prometheus = [0,2,4,6,11]
scriabin :: Num a => [a]
scriabin = [0,1,4,7,9]
-- han chinese pentatonic scales
gong :: Num a => [a]
gong = [0,2,4,7,9]
shang :: Num a => [a]
shang = [0,2,5,7,10]
jiao :: Num a => [a]
jiao = [0,3,5,8,10]
zhi :: Num a => [a]
zhi = [0,2,5,7,9]
yu :: Num a => [a]
yu = [0,3,5,7,10]
-- 6 note scales
whole :: Num a => [a]
whole = [0,2,4,6,8,10]
augmented :: Num a => [a]
augmented = [0,3,4,7,8,11]
augmented2 :: Num a => [a]
augmented2 = [0,1,4,5,8,9]
-- hexatonic modes with no tritone
hexMajor7 :: Num a => [a]
hexMajor7 = [0,2,4,7,9,11]
hexDorian :: Num a => [a]
hexDorian = [0,2,3,5,7,10]
hexPhrygian :: Num a => [a]
hexPhrygian = [0,1,3,5,8,10]
hexSus :: Num a => [a]
hexSus = [0,2,5,7,9,10]
hexMajor6 :: Num a => [a]
hexMajor6 = [0,2,4,5,7,9]
hexAeolian :: Num a => [a]
hexAeolian = [0,3,5,7,8,10]
-- 7 note scales
major :: Num a => [a]
major = [0,2,4,5,7,9,11]
ionian :: Num a => [a]
ionian = [0,2,4,5,7,9,11]
dorian :: Num a => [a]
dorian = [0,2,3,5,7,9,10]
phrygian :: Num a => [a]
phrygian = [0,1,3,5,7,8,10]
lydian :: Num a => [a]
lydian = [0,2,4,6,7,9,11]
mixolydian :: Num a => [a]
mixolydian = [0,2,4,5,7,9,10]
aeolian :: Num a => [a]
aeolian = [0,2,3,5,7,8,10]
minor :: Num a => [a]
minor = [0,2,3,5,7,8,10]
locrian :: Num a => [a]
locrian = [0,1,3,5,6,8,10]
harmonicMinor :: Num a => [a]
harmonicMinor = [0,2,3,5,7,8,11]
harmonicMajor :: Num a => [a]
harmonicMajor = [0,2,4,5,7,8,11]
melodicMinor :: Num a => [a]
melodicMinor = [0,2,3,5,7,9,11]
melodicMinorDesc :: Num a => [a]
melodicMinorDesc = [0,2,3,5,7,8,10]
melodicMajor :: Num a => [a]
melodicMajor = [0,2,4,5,7,8,10]
bartok :: Num a => [a]
bartok = [0,2,4,5,7,8,10]
hindu :: Num a => [a]
hindu = [0,2,4,5,7,8,10]
-- raga modes
todi :: Num a => [a]
todi = [0,1,3,6,7,8,11]
purvi :: Num a => [a]
purvi = [0,1,4,6,7,8,11]
marva :: Num a => [a]
marva = [0,1,4,6,7,9,11]
bhairav :: Num a => [a]
bhairav = [0,1,4,5,7,8,11]
ahirbhairav :: Num a => [a]
ahirbhairav = [0,1,4,5,7,9,10]
--
superLocrian :: Num a => [a]
superLocrian = [0,1,3,4,6,8,10]
romanianMinor :: Num a => [a]
romanianMinor = [0,2,3,6,7,9,10]
hungarianMinor :: Num a => [a]
hungarianMinor = [0,2,3,6,7,8,11]
neapolitanMinor :: Num a => [a]
neapolitanMinor = [0,1,3,5,7,8,11]
enigmatic :: Num a => [a]
enigmatic = [0,1,4,6,8,10,11]
spanish :: Num a => [a]
spanish = [0,1,4,5,7,8,10]
-- modes of whole tones with added note ->
leadingWhole :: Num a => [a]
leadingWhole = [0,2,4,6,8,10,11]
lydianMinor :: Num a => [a]
lydianMinor = [0,2,4,6,7,8,10]
neapolitanMajor :: Num a => [a]
neapolitanMajor = [0,1,3,5,7,9,11]
locrianMajor :: Num a => [a]
locrianMajor = [0,2,4,5,6,8,10]
-- 8 note scales
diminished :: Num a => [a]
diminished = [0,1,3,4,6,7,9,10]
diminished2 :: Num a => [a]
diminished2 = [0,2,3,5,6,8,9,11]
-- 12 note scales
chromatic :: Num a => [a]
chromatic = [0,1,2,3,4,5,6,7,8,9,10,11]
tidal-0.9.5/Sound/Tidal/Version.hs 0000644 0000000 0000000 00000000073 13212576414 015123 0 ustar 00 0000000 0000000
module Sound.Tidal.Version where
tidal_version = "0.9.5"
tidal-0.9.5/Sound/Tidal/OscStream.hs 0000644 0000000 0000000 00000007212 13212576414 015400 0 ustar 00 0000000 0000000 module Sound.Tidal.OscStream where
import qualified Data.Map as Map
import Data.Maybe
import Sound.Tidal.Tempo (Tempo, cps)
import Sound.Tidal.Stream
import Sound.Tidal.Utils
import GHC.Float (float2Double, double2Float)
import Sound.OSC.FD
import Sound.OSC.Datum
import Sound.Tidal.Params
data TimeStamp = BundleStamp | MessageStamp | NoStamp
deriving Eq
data OscSlang = OscSlang {path :: String,
timestamp :: TimeStamp,
namedParams :: Bool,
preamble :: [Datum]
}
type OscMap = Map.Map Param Datum
toOscDatum :: Value -> Datum
toOscDatum (VF x) = float x
toOscDatum (VI x) = int32 x
toOscDatum (VS x) = string x
toOscMap :: ParamMap -> OscMap
toOscMap m = Map.map (toOscDatum) m
-- constructs and sends an Osc Message according to the given slang
-- and other params - this is essentially the same as the former
-- toMessage in Stream.hs
send
:: (Integral a) =>
UDP
-> OscSlang
-> Shape
-> Tempo
-> a
-> (Double,
Double,
OscMap)
-> IO ()
send s slang shape change tick (on, off, m) = osc
where
osc | timestamp slang == BundleStamp =
sendOSC s $ Bundle (ut_to_ntpr logicalOnset) [Message (path slang) oscdata]
| timestamp slang == MessageStamp =
sendOSC s $ Message (path slang) ((int32 sec):(int32 usec):oscdata)
| otherwise =
doAt logicalOnset $ sendOSC s $ Message (path slang) oscdata
oscPreamble = cpsPrefix ++ preamble slang
oscdata | namedParams slang = oscPreamble ++ (concatMap (\(k, v) -> [string (name k), v] )
$ Map.assocs m)
| otherwise = oscPreamble ++ (catMaybes $ map (\x -> Map.lookup x m) (params shape))
cpsPrefix | cpsStamp shape && namedParams slang = [string "cps",
float (cps change),
string "delta",
float (logicalOffset
- logicalOnset),
string "cycle", float cycle
]
| cpsStamp shape = [float (cps change)]
| otherwise = []
cycle = (on + fromIntegral tick) / (fromIntegral ticksPerCycle)
_parameterise ds = mergelists (map (string . name) (params shape)) ds
usec = floor $ 1000000 * (logicalOnset - (fromIntegral sec))
sec = floor logicalOnset
logicalOnset = logicalOnset' change tick on ((latency shape) + nudge)
logicalOffset = logicalOnset' change tick off ((latency shape) + nudge)
nudge = maybe 0 (toF) (Map.lookup nudge_p (m :: OscMap))
toF (Float f) = float2Double f
toF _ = 0
-- type OscMap = Map.Map Param (Maybe Datum)
-- Returns a function that will convert a generic ParamMap into a specific Osc message and send it over UDP to the supplied server
-- messages will be built according to the given OscSlang
makeConnection :: String -> Int -> OscSlang -> IO (ToMessageFunc)
makeConnection address port slang = do
s <- openUDP address port
return (\ shape change tick (on,off,m) -> do
let m' = if (namedParams slang) then (Just m) else (applyShape' shape m)
-- this might result in Nothing, make sure we do this first
m'' <- fmap (toOscMap) m'
-- to allow us to simplify `send` (no `do`)
return $ send s slang shape change tick (on,off,m'')
)
tidal-0.9.5/Sound/Tidal/Utils.hs 0000644 0000000 0000000 00000005504 13212576414 014602 0 ustar 00 0000000 0000000 {-|
Module: Utils
Description: Helper functions not directly specific to Tidal
-}
module Sound.Tidal.Utils where
import Data.Maybe (listToMaybe)
{- | enumerate a list of things
>>> enumerate ["foo","bar","baz"]
[(1,"foo"), (2,"bar"), (3,"baz")]
-}
enumerate :: [a] -> [(Int, a)]
enumerate = zip [0..]
-- | apply @f@ to the first element of a tuple
mapFst :: (a -> b) -> (a, c) -> (b, c)
mapFst f (x,y) = (f x,y)
-- | apply function to the first value of each tuple in given list
mapFsts :: (a -> b) -> [(a, c)] -> [(b, c)]
mapFsts = map . mapFst
-- | apply @f@ to the second element of a tuple
mapSnd :: (a -> b) -> (c, a) -> (c, b)
mapSnd f (x,y) = (x,f y)
-- | apply function to the second value of each tuple in given list
mapSnds :: (a -> b) -> [(c, a)] -> [(c, b)]
mapSnds = fmap . mapSnd
{- | split given list of @a@ by given single a, e.g.
>>> wordsBy (== ':') "bd:3"
["bd", "3"]
-}
wordsBy :: (a -> Bool) -> [a] -> [[a]]
wordsBy p s = case dropWhile p s of
[] -> []
s':rest -> (s':w) : wordsBy p (drop 1 s'')
where (w, s'') = break p rest
maybeRead :: String -> Maybe Double
maybeRead = fmap fst . listToMaybe . reads
-- | shorthand for first element of triple
fst' (a, _, _) = a
-- | shorthand for second element of triple
snd' (_, b, _) = b
-- | shorthand for third element of triple
thd' (_, _, c) = c
-- | apply @f@ to the first element of a triple
mapFst' :: (a -> x) -> (a, b, c) -> (x, b, c)
mapFst' f (x,y,z) = (f x,y,z)
-- | apply @f@ to the second element of a triple
mapSnd' :: (b -> x) -> (a, b, c) -> (a, x, c)
mapSnd' f (x,y,z) = (x,f y,z)
-- | apply @f@ to the third element of a triple
mapThd' :: (c -> x) -> (a, b, c) -> (a, b, x)
mapThd' f (x,y,z) = (x,y,f z)
-- | apply function to the second value of each triple in given list
mapFsts' :: (a -> x) -> [(a, b, c)] -> [(x, b, c)]
mapFsts' = fmap . mapFst'
-- | apply function to the second value of each triple in given list
mapSnds' :: (b -> x) -> [(a, b, c)] -> [(a, x, c)]
mapSnds' = fmap . mapSnd'
-- | apply function to the third value of each triple in given list
mapThds' :: (c -> x) -> [(a, b, c)] -> [(a, b, x)]
mapThds' = fmap . mapThd'
-- | map @f@ over a given list of arcs
mapArcs :: (a -> a) -> [(a, a, x)] -> [(a, a, x)]
mapArcs f = (mapFsts' f) . (mapSnds' f)
{- | combines two lists by interleaving them
>>> mergelists [1,2,3] [9,8,7]
[1,9,2,8,3,7]
-}
mergelists :: [a] -> [a] -> [a]
mergelists xs [] = xs
mergelists [] ys = ys
mergelists (x:xs) (y:ys) = x : y : mergelists xs ys
{- | like `!!` selects @n@th element from xs, but wraps over at the end of @xs@
>>> map ((!!!) [1,3,5]) [0,1,2,3,4,5]
[1,3,5,1,3,5]
-}
(!!!) :: [a] -> Int -> a
(!!!) xs n = xs !! (n `mod` length xs)
accumulate :: Num t => [t] -> [t]
accumulate = accumulate' 0
where accumulate' _ [] = []
accumulate' n (a:xs) = (n+a):(accumulate' (n+a) xs)
tidal-0.9.5/Sound/Tidal/Context.hs 0000644 0000000 0000000 00000001263 13212576414 015124 0 ustar 00 0000000 0000000 module Sound.Tidal.Context (module C) where
import Control.Concurrent as C
import Data.List as C
import Control.Applicative as C
import Data.Ratio as C
import Data.Monoid as C
import Sound.Tidal.Parse as C
import Sound.Tidal.Pattern as C
-- import Sound.Tidal.PatternList as C
import Sound.Tidal.Stream as C
import Sound.Tidal.Dirt as C
import Sound.Tidal.Strategies as C
import Sound.Tidal.Tempo as C
import Sound.Tidal.Time as C
import Sound.Tidal.Sieve as C
import Sound.Tidal.SuperCollider as C
import Sound.Tidal.Params as C
import Sound.Tidal.Transition as C
import Sound.Tidal.Version as C
import qualified Sound.Tidal.Scales as Scales
import qualified Sound.Tidal.Chords as Chords
tidal-0.9.5/Sound/Tidal/Pattern.hs 0000644 0000000 0000000 00000173434 13212576414 015127 0 ustar 00 0000000 0000000 {-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_GHC -Wall -fno-warn-orphans -fno-warn-name-shadowing #-}
module Sound.Tidal.Pattern where
import Control.Applicative
import Data.Monoid
import Data.Fixed
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
-- import Debug.Trace
import Data.Typeable
import Data.Function
import System.Random.Mersenne.Pure64
-- import Data.Char
import qualified Data.Text as T
import Sound.Tidal.Time
import Sound.Tidal.Utils
import Sound.Tidal.Bjorklund
import Text.Show.Functions ()
import qualified Control.Exception as E
-- | The pattern datatype, a function from a time @Arc@ to @Event@
-- values. For discrete patterns, this returns the events which are
-- active during that time. For continuous patterns, events with
-- values for the midpoint of the given @Arc@ is returned.
data Pattern a = Pattern {arc :: Arc -> [Event a]}
deriving Typeable
noOv :: String -> a
noOv meth = error $ meth ++ ": No overloading"
instance Eq (Pattern a) where
(==) = noOv "(==)"
instance Ord a => Ord (Pattern a) where
min = liftA2 min
max = liftA2 max
instance Num a => Num (Pattern a) where
negate = fmap negate
(+) = liftA2 (+)
(*) = liftA2 (*)
fromInteger = pure . fromInteger
abs = fmap abs
signum = fmap signum
instance Enum a => Enum (Pattern a) where
succ = fmap succ
pred = fmap pred
toEnum = pure . toEnum
fromEnum = noOv "fromEnum"
enumFrom = noOv "enumFrom"
enumFromThen = noOv "enumFromThen"
enumFromTo = noOv "enumFromTo"
enumFromThenTo = noOv "enumFromThenTo"
instance (Num a, Ord a) => Real (Pattern a) where
toRational = noOv "toRational"
instance (Integral a) => Integral (Pattern a) where
quot = liftA2 quot
rem = liftA2 rem
div = liftA2 div
mod = liftA2 mod
toInteger = noOv "toInteger"
x `quotRem` y = (x `quot` y, x `rem` y)
x `divMod` y = (x `div` y, x `mod` y)
instance (Fractional a) => Fractional (Pattern a) where
recip = fmap recip
fromRational = pure . fromRational
instance (Floating a) => Floating (Pattern a) where
pi = pure pi
sqrt = fmap sqrt
exp = fmap exp
log = fmap log
sin = fmap sin
cos = fmap cos
asin = fmap asin
atan = fmap atan
acos = fmap acos
sinh = fmap sinh
cosh = fmap cosh
asinh = fmap asinh
atanh = fmap atanh
acosh = fmap acosh
instance (RealFrac a) => RealFrac (Pattern a) where
properFraction = noOv "properFraction"
truncate = noOv "truncate"
round = noOv "round"
ceiling = noOv "ceiling"
floor = noOv "floor"
instance (RealFloat a) => RealFloat (Pattern a) where
floatRadix = noOv "floatRadix"
floatDigits = noOv "floatDigits"
floatRange = noOv "floatRange"
decodeFloat = noOv "decodeFloat"
encodeFloat = ((.).(.)) pure encodeFloat
exponent = noOv "exponent"
significand = noOv "significand"
scaleFloat n = fmap (scaleFloat n)
isNaN = noOv "isNaN"
isInfinite = noOv "isInfinite"
isDenormalized = noOv "isDenormalized"
isNegativeZero = noOv "isNegativeZero"
isIEEE = noOv "isIEEE"
atan2 = liftA2 atan2
-- | @show (p :: Pattern)@ returns a text string representing the
-- event values active during the first cycle of the given pattern.
instance (Show a) => Show (Pattern a) where
show p@(Pattern _) = intercalate " " $ map showEvent $ arc p (0, 1)
-- | converts a ratio into human readable string, e.g. @1/3@
showTime :: (Show a, Integral a) => Ratio a -> String
showTime t | denominator t == 1 = show (numerator t)
| otherwise = show (numerator t) ++ ('/':show (denominator t))
-- | converts a time arc into human readable string, e.g. @1/3 3/4@
showArc :: Arc -> String
showArc a = concat[showTime $ fst a, (' ':showTime (snd a))]
-- | converts an event into human readable string, e.g. @("bd" 1/4 2/3)@
showEvent :: (Show a) => Event a -> String
showEvent e@(_, b, v) = concat[on, show v, off,
(' ':showArc b),
"\n"
]
where on | hasOnset e = ""
| otherwise = ".."
off | hasOffset e = ""
| otherwise = ".."
instance Functor Pattern where
fmap f (Pattern a) = Pattern $ fmap (fmap (mapThd' f)) a
-- | @pure a@ returns a pattern with an event with value @a@, which
-- has a duration of one cycle, and repeats every cycle.
instance Applicative Pattern where
pure x = Pattern $ \(s, e) -> map
(\t -> ((t%1, (t+1)%1),
(t%1, (t+1)%1),
x
)
)
[floor s .. ((ceiling e) - 1)]
(Pattern fs) <*> (Pattern xs) =
Pattern $ \a -> concatMap applyX (fs a)
where applyX ((s,e), (s', e'), f) =
map (\(_, _, x) -> ((s,e), (s', e'), f x))
(filter
(\(_, a', _) -> isIn a' s)
(xs (s',e'))
)
-- | @mempty@ is a synonym for @silence@.
-- | @mappend@ is a synonym for @overlay@.
instance Monoid (Pattern a) where
mempty = silence
mappend = overlay
instance Monad Pattern where
return = pure
p >>= f = unwrap (f <$> p)
unwrap :: Pattern (Pattern a) -> Pattern a
unwrap p = Pattern $ \a -> concatMap (\(_, outerPart, p') -> catMaybes $ map (munge outerPart) $ arc p' a) (arc p a)
where munge a (whole,part,v) = do part' <- subArc a part
return (whole, part',v)
-- | @atom@ is a synonym for @pure@.
atom :: a -> Pattern a
atom = pure
-- | @silence@ returns a pattern with no events.
silence :: Pattern a
silence = Pattern $ const []
-- | @withQueryArc f p@ returns a new @Pattern@ with function @f@
-- applied to the @Arc@ values passed to the original @Pattern@ @p@.
withQueryArc :: (Arc -> Arc) -> Pattern a -> Pattern a
withQueryArc f p = Pattern $ \a -> arc p (f a)
-- | @withQueryTime f p@ returns a new @Pattern@ with function @f@
-- applied to the both the start and end @Time@ of the @Arc@ passed to
-- @Pattern@ @p@.
withQueryTime :: (Time -> Time) -> Pattern a -> Pattern a
withQueryTime = withQueryArc . mapArc
-- | @withResultArc f p@ returns a new @Pattern@ with function @f@
-- applied to the @Arc@ values in the events returned from the
-- original @Pattern@ @p@.
withResultArc :: (Arc -> Arc) -> Pattern a -> Pattern a
withResultArc f p = Pattern $ \a -> mapArcs f $ arc p a
-- | @withResultTime f p@ returns a new @Pattern@ with function @f@
-- applied to the both the start and end @Time@ of the @Arc@ values in
-- the events returned from the original @Pattern@ @p@.
withResultTime :: (Time -> Time) -> Pattern a -> Pattern a
withResultTime = withResultArc . mapArc
-- | @withEvent f p@ returns a new @Pattern@ with events mapped over
-- function @f@.
withEvent :: (Event a -> Event b) -> Pattern a -> Pattern b
withEvent f p = Pattern $ \a -> map f $ arc p a
-- | @timedValues p@ returns a new @Pattern@ where values are turned
-- into tuples of @Arc@ and value.
timedValues :: Pattern a -> Pattern (Arc, a)
timedValues = withEvent (\(a,a',v) -> (a,a',(a,v)))
-- | @overlay@ combines two @Pattern@s into a new pattern, so that
-- their events are combined over time. This is the same as the infix
-- operator `<>`.
overlay :: Pattern a -> Pattern a -> Pattern a
overlay p p' = Pattern $ \a -> (arc p a) ++ (arc p' a)
-- | @stack@ combines a list of @Pattern@s into a new pattern, so that
-- their events are combined over time.
stack :: [Pattern a] -> Pattern a
stack ps = foldr overlay silence ps
-- | @append@ combines two patterns @Pattern@s into a new pattern, so
-- that the events of the second pattern are appended to those of the
-- first pattern, within a single cycle
append :: Pattern a -> Pattern a -> Pattern a
append a b = fastcat [a,b]
-- | @append'@ does the same as @append@, but over two cycles, so that
-- the cycles alternate between the two patterns.
append' :: Pattern a -> Pattern a -> Pattern a
append' a b = slowcat [a,b]
-- | @fastcat@ returns a new pattern which interlaces the cycles of the
-- given patterns, within a single cycle. It's the equivalent of
-- @append@, but with a list of patterns.
fastcat :: [Pattern a] -> Pattern a
fastcat ps = _density (fromIntegral $ length ps) $ slowcat ps
splitAtSam :: Pattern a -> Pattern a
splitAtSam p =
splitQueries $ Pattern $ \(s,e) -> mapSnds' (trimArc (sam s)) $ arc p (s,e)
where trimArc s' (s,e) = (max (s') s, min (s'+1) e)
-- | @slowcat@ does the same as @fastcat@, but maintaining the duration of
-- the original patterns. It is the equivalent of @append'@, but with
-- a list of patterns.
slowcat :: [Pattern a] -> Pattern a
slowcat [] = silence
slowcat ps = splitQueries $ Pattern f
where ps' = map splitAtSam ps
l = length ps'
f (s,e) = arc (withResultTime (+offset) p) (s',e')
where p = ps' !! n
r = (floor s) :: Int
n = (r `mod` l) :: Int
offset = (fromIntegral $ r - ((r - n) `div` l)) :: Time
(s', e') = (s-offset, e-offset)
-- | @cat@ is an alias of @slowcat@
cat :: [Pattern a] -> Pattern a
cat = slowcat
-- | @listToPat@ turns the given list of values to a Pattern, which
-- cycles through the list.
listToPat :: [a] -> Pattern a
listToPat = fastcat . map atom
patToList :: Pattern a -> [a]
patToList p = map (thd') $ sortBy (\a b -> compare (snd' a) (snd' b)) $ filter ((\x -> x >= 0 && x < 1) . fst . snd' ) (arc p (0,1))
-- | @maybeListToPat@ is similar to @listToPat@, but allows values to
-- be optional using the @Maybe@ type, so that @Nothing@ results in
-- gaps in the pattern.
maybeListToPat :: [Maybe a] -> Pattern a
maybeListToPat = fastcat . map f
where f Nothing = silence
f (Just x) = atom x
-- | @run@ @n@ returns a pattern representing a cycle of numbers from @0@ to @n-1@.
run :: (Enum a, Num a) => Pattern a -> Pattern a
run tp = tp >>= _run
_run :: (Enum a, Num a) => a -> Pattern a
_run n = listToPat [0 .. n-1]
scan :: (Enum a, Num a) => Pattern a -> Pattern a
scan tp = tp >>= _scan
_scan :: (Enum a, Num a) => a -> Pattern a
_scan n = slowcat $ map _run [1 .. n]
temporalParam :: (a -> Pattern b -> Pattern c) -> (Pattern a -> Pattern b -> Pattern c)
temporalParam f tv p = unwrap $ (\v -> f v p) <$> tv
temporalParam2 :: (a -> b -> Pattern c -> Pattern d) -> (Pattern a -> Pattern b -> Pattern c -> Pattern d)
temporalParam2 f a b p = unwrap $ (\x y -> f x y p) <$> a <*> b
temporalParam3 :: (a -> b -> c -> Pattern d -> Pattern e) -> (Pattern a -> Pattern b -> Pattern c -> Pattern d -> Pattern e)
temporalParam3 f a b c p = unwrap $ (\x y z -> f x y z p) <$> a <*> b <*> c
temporalParam' :: (a -> Pattern b -> Pattern c) -> (Pattern a -> Pattern b -> Pattern c)
temporalParam' f tv p = unwrap' $ (\v -> f v p) <$> tv
temporalParam2' :: (a -> b -> Pattern c -> Pattern d) -> (Pattern a -> Pattern b -> Pattern c -> Pattern d)
temporalParam2' f a b p = unwrap' $ (\x y -> f x y p) <$> a <*> b
temporalParam3' :: (a -> b -> c -> Pattern d -> Pattern e) -> (Pattern a -> Pattern b -> Pattern c -> Pattern d -> Pattern e)
temporalParam3' f a b c p = unwrap' $ (\x y z -> f x y z p) <$> a <*> b <*> c
-- | @fast@ (also known as @density@) returns the given pattern with speed
-- (or density) increased by the given @Time@ factor. Therefore @fast 2 p@
-- will return a pattern that is twice as fast, and @fast (1/3) p@
-- will return one three times as slow.
fast :: Pattern Time -> Pattern a -> Pattern a
fast = temporalParam _density
_fast :: Time -> Pattern a -> Pattern a
_fast = _density
fast' :: Pattern Time -> Pattern a -> Pattern a
fast' = temporalParam' _density
-- | @density@ is an alias of @fast@. @fast@ is quicker to type, but
-- @density@ is its old name so is used in a lot of examples.
density :: Pattern Time -> Pattern a -> Pattern a
density = fast
_density :: Time -> Pattern a -> Pattern a
_density r p | r == 0 = silence
| r < 0 = rev $ _density (0-r) p
| otherwise = withResultTime (/ r) $ withQueryTime (* r) p
-- | @fastGap@ (also known as @densityGap@ is similar to @fast@ but maintains its cyclic
-- alignment. For example, @fastGap 2 p@ would squash the events in
-- pattern @p@ into the first half of each cycle (and the second
-- halves would be empty).
fastGap :: Time -> Pattern a -> Pattern a
fastGap 0 _ = silence
fastGap r p = splitQueries $ withResultArc (\(s,e) -> (sam s + ((s - sam s)/r), (sam s + ((e - sam s)/r)))) $ Pattern (\a -> arc p $ mapArc (\t -> sam t + (min 1 (r * cyclePos t))) a)
densityGap :: Time -> Pattern a -> Pattern a
densityGap = fastGap
-- | @slow@ does the opposite of @fast@, i.e. @slow 2 p@ will return a
-- pattern that is half the speed.
slow :: Pattern Time -> Pattern a -> Pattern a
slow = temporalParam _slow
sparsity :: Pattern Time -> Pattern a -> Pattern a
sparsity = slow
slow' :: Pattern Time -> Pattern a -> Pattern a
slow' = temporalParam' _slow
_slow :: Time -> Pattern a -> Pattern a
_slow t p = _density (1/t) p
-- | The @<~@ operator shifts (or rotates) a pattern to the left (or
-- counter-clockwise) by the given @Time@ value. For example
-- @(1%16) <~ p@ will return a pattern with all the events moved
-- one 16th of a cycle to the left.
rotL :: Time -> Pattern a -> Pattern a
rotL t p = withResultTime (subtract t) $ withQueryTime (+ t) p
(<~) :: Pattern Time -> Pattern a -> Pattern a
(<~) = temporalParam rotL
-- | The @~>@ operator does the same as @<~@ but shifts events to the
-- right (or clockwise) rather than to the left.
rotR :: Time -> Pattern a -> Pattern a
rotR = (rotL) . (0-)
(~>) :: Pattern Time -> Pattern a -> Pattern a
(~>) = temporalParam rotR
{- | (The above means that `brak` is a function from patterns of any type,
to a pattern of the same type.)
Make a pattern sound a bit like a breakbeat
Example:
@
d1 $ sound (brak "bd sn kurt")
@
-}
brak :: Pattern a -> Pattern a
brak = when ((== 1) . (`mod` 2)) (((1%4) `rotR`) . (\x -> fastcat [x, silence]))
{- | Divides a pattern into a given number of subdivisions, plays the subdivisions
in order, but increments the starting subdivision each cycle. The pattern
wraps to the first subdivision after the last subdivision is played.
Example:
@
d1 $ iter 4 $ sound "bd hh sn cp"
@
This will produce the following over four cycles:
@
bd hh sn cp
hh sn cp bd
sn cp bd hh
cp bd hh sn
@
There is also `iter'`, which shifts the pattern in the opposite direction.
-}
iter :: Pattern Int -> Pattern c -> Pattern c
iter = temporalParam _iter
_iter :: Int -> Pattern a -> Pattern a
_iter n p = slowcat $ map (\i -> ((fromIntegral i)%(fromIntegral n)) `rotL` p) [0 .. (n-1)]
-- | @iter'@ is the same as @iter@, but decrements the starting
-- subdivision instead of incrementing it.
iter' :: Pattern Int -> Pattern c -> Pattern c
iter' = temporalParam _iter'
_iter' :: Int -> Pattern a -> Pattern a
_iter' n p = slowcat $ map (\i -> ((fromIntegral i)%(fromIntegral n)) `rotR` p) [0 .. (n-1)]
-- | @rev p@ returns @p@ with the event positions in each cycle
-- reversed (or mirrored).
rev :: Pattern a -> Pattern a
rev p = splitQueries $ Pattern $ \a -> map makeWholeAbsolute $ mapSnds' (mirrorArc (mid a)) $ map makeWholeRelative (arc p (mirrorArc (mid a) a))
where makeWholeRelative ((s,e), part@(s',e'), v) = ((s'-s, e-e'), part, v)
makeWholeAbsolute ((s,e), part@(s',e'), v) = ((s'-e,e'+s), part, v)
mid (s,e) = (sam s) + 0.5
-- | @palindrome p@ applies @rev@ to @p@ every other cycle, so that
-- the pattern alternates between forwards and backwards.
palindrome :: Pattern a -> Pattern a
palindrome p = append' p (rev p)
{-|
Only `when` the given test function returns `True` the given pattern transformation is applied. The test function will be called with the current cycle as a number.
@
d1 $ when ((elem '4').show)
(striate 4)
$ sound "hh hc"
@
The above will only apply `striate 4` to the pattern if the current cycle number contains the number 4. So the fourth cycle will be striated and the fourteenth and so on. Expect lots of striates after cycle number 399.
-}
when :: (Int -> Bool) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
when test f p = splitQueries $ Pattern apply
where apply a | test (floor $ fst a) = (arc $ f p) a
| otherwise = (arc p) a
whenT :: (Time -> Bool) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
whenT test f p = splitQueries $ Pattern apply
where apply a | test (fst a) = (arc $ f p) a
| otherwise = (arc p) a
playWhen :: (Time -> Bool) -> Pattern a -> Pattern a
playWhen test (Pattern f) = Pattern $ (filter (\e -> test (eventOnset e))) . f
playFor :: Time -> Time -> Pattern a -> Pattern a
playFor s e = playWhen (\t -> and [t >= s, t < e])
{- | The function @seqP@ allows you to define when
a sound within a list starts and ends. The code below contains three
separate patterns in a `stack`, but each has different start times
(zero cycles, eight cycles, and sixteen cycles, respectively). All
patterns stop after 128 cycles:
@
d1 $ seqP [
(0, 128, sound "bd bd*2"),
(8, 128, sound "hh*2 [sn cp] cp future*4"),
(16, 128, sound (samples "arpy*8" (run 16)))
]
@
-}
seqP :: [(Time, Time, Pattern a)] -> Pattern a
seqP ps = stack $ map (\(s, e, p) -> playFor s e ((sam s) `rotR` p)) ps
-- | @every n f p@ applies the function @f@ to @p@, but only affects
-- every @n@ cycles.
every :: Pattern Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
every tp f p = tp >>= \t -> _every t f p
_every :: Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_every 0 _ p = p
_every n f p = when ((== 0) . (`mod` n)) f p
-- | @every n o f'@ is like @every n f@ with an offset of @o@ cycles
every' :: Pattern Int -> Pattern Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
every' np op f p = do { n <- np; o <- op; _every' n o f p }
_every' :: Int -> Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_every' n o f = when ((== o) . (`mod` n)) f
-- | @foldEvery ns f p@ applies the function @f@ to @p@, and is applied for
-- each cycle in @ns@.
foldEvery :: [Int] -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
foldEvery ns f p = foldr ($) p (map (\x -> _every x f) ns)
-- | @sig f@ takes a function from time to values, and turns it into a
-- @Pattern@.
sig :: (Time -> a) -> Pattern a
sig f = Pattern f'
where f' (s,e) | s > e = []
| otherwise = [((s,e), (s,e), f s)]
-- | @sinewave@ returns a @Pattern@ of continuous @Double@ values following a
-- sinewave with frequency of one cycle, and amplitude from 0 to 1.
sinewave :: Pattern Double
sinewave = sig $ \t -> ((sin $ pi * 2 * (fromRational t)) + 1) / 2
-- | @sine@ is a synonym for @sinewave@.
sine :: Pattern Double
sine = sinewave
-- | @sine@ is a synonym for @0.25 ~> sine@.
cosine :: Pattern Double
cosine = 0.25 ~> sine
-- | @sinerat@ is equivalent to @sinewave@ for @Rational@ values,
-- suitable for use as @Time@ offsets.
sinerat :: Pattern Rational
sinerat = fmap toRational sine
-- | @ratsine@ is a synonym for @sinerat@.
ratsine :: Pattern Rational
ratsine = sinerat
-- | @sineAmp d@ returns @sinewave@ with its amplitude offset by @d@.
-- Deprecated, as these days you can simply do e.g. (sine + 0.5)
sineAmp :: Double -> Pattern Double
sineAmp offset = (+ offset) <$> sinewave1
-- | @sawwave@ is the equivalent of @sinewave@ for (ascending) sawtooth waves.
sawwave :: Pattern Double
sawwave = sig $ \t -> mod' (fromRational t) 1
-- | @saw@ is a synonym for @sawwave@.
saw :: Pattern Double
saw = sawwave
-- | @sawrat@ is the same as @sawwave@ but returns @Rational@ values
-- suitable for use as @Time@ offsets.
sawrat :: Pattern Rational
sawrat = fmap toRational saw
-- | @triwave@ is the equivalent of @sinewave@ for triangular waves.
triwave :: Pattern Double
triwave = append sawwave1 (rev sawwave1)
-- | @tri@ is a synonym for @triwave@.
tri :: Pattern Double
tri = triwave
-- | @trirat@ is the same as @triwave@ but returns @Rational@ values
-- suitable for use as @Time@ offsets.
trirat :: Pattern Rational
trirat = fmap toRational tri
-- | @squarewave1@ is the equivalent of @sinewave@ for square waves.
squarewave :: Pattern Double
squarewave = sig $
\t -> fromIntegral $ ((floor $ (mod' (fromRational t :: Double) 1) * 2) :: Integer)
-- | @square@ is a synonym for @squarewave@.
square :: Pattern Double
square = squarewave
-- deprecated..
sinewave1 :: Pattern Double
sinewave1 = sinewave
sine1 :: Pattern Double
sine1 = sinewave
sinerat1 :: Pattern Rational
sinerat1 = sinerat
sineAmp1 :: Double -> Pattern Double
sineAmp1 = sineAmp
sawwave1 :: Pattern Double
sawwave1 = sawwave
saw1 :: Pattern Double
saw1 = sawwave
sawrat1 :: Pattern Rational
sawrat1 = sawrat
triwave1 :: Pattern Double
triwave1 = triwave
tri1 :: Pattern Double
tri1 = triwave
trirat1 :: Pattern Rational
trirat1 = trirat
squarewave1 :: Pattern Double
squarewave1 = squarewave
square1 :: Pattern Double
square1 = square
-- | @envL@ is a @Pattern@ of continuous @Double@ values, representing
-- a linear interpolation between 0 and 1 during the first cycle, then
-- staying constant at 1 for all following cycles. Possibly only
-- useful if you're using something like the retrig function defined
-- in tidal.el.
envL :: Pattern Double
envL = sig $ \t -> max 0 $ min (fromRational t) 1
-- like envL but reversed.
envLR :: Pattern Double
envLR = (1-) <$> envL
-- 'Equal power' for gain-based transitions
envEq :: Pattern Double
envEq = sig $ \t -> sqrt (sin (pi/2 * (max 0 $ min (fromRational (1-t)) 1)))
-- Equal power reversed
envEqR :: Pattern Double
envEqR = sig $ \t -> sqrt (cos (pi/2 * (max 0 $ min (fromRational (1-t)) 1)))
fadeOut :: Time -> Pattern a -> Pattern a
fadeOut n = spread' (_degradeBy) (_slow n $ envL)
-- Alternate versions where you can provide the time from which the fade starts
fadeOut' :: Time -> Time -> Pattern a -> Pattern a
fadeOut' from dur p = spread' (_degradeBy) (from `rotR` _slow dur envL) p
-- The 1 <~ is so fade ins and outs have different degredations
fadeIn' :: Time -> Time -> Pattern a -> Pattern a
fadeIn' from dur p = spread' (\n p -> 1 `rotL` _degradeBy n p) (from `rotR` _slow dur ((1-) <$> envL)) p
fadeIn :: Time -> Pattern a -> Pattern a
fadeIn n = spread' (_degradeBy) (_slow n $ (1-) <$> envL)
{- | (The above is difficult to describe, if you don't understand Haskell,
just ignore it and read the below..)
The `spread` function allows you to take a pattern transformation
which takes a parameter, such as `slow`, and provide several
parameters which are switched between. In other words it 'spreads' a
function across several values.
Taking a simple high hat loop as an example:
@
d1 $ sound "ho ho:2 ho:3 hc"
@
We can slow it down by different amounts, such as by a half:
@
d1 $ slow 2 $ sound "ho ho:2 ho:3 hc"
@
Or by four thirds (i.e. speeding it up by a third; `4%3` means four over
three):
@
d1 $ slow (4%3) $ sound "ho ho:2 ho:3 hc"
@
But if we use `spread`, we can make a pattern which alternates between
the two speeds:
@
d1 $ spread slow [2,4%3] $ sound "ho ho:2 ho:3 hc"
@
Note that if you pass ($) as the function to spread values over, you
can put functions as the list of values. For example:
@
d1 $ spread ($) [density 2, rev, slow 2, striate 3, (# speed "0.8")]
$ sound "[bd*2 [~ bd]] [sn future]*2 cp jvbass*4"
@
Above, the pattern will have these transforms applied to it, one at a time, per cycle:
* cycle 1: `density 2` - pattern will increase in speed
* cycle 2: `rev` - pattern will be reversed
* cycle 3: `slow 2` - pattern will decrease in speed
* cycle 4: `striate 3` - pattern will be granualized
* cycle 5: `(# speed "0.8")` - pattern samples will be played back more slowly
After `(# speed "0.8")`, the transforms will repeat and start at `density 2` again.
-}
spread :: (a -> t -> Pattern b) -> [a] -> t -> Pattern b
spread f xs p = slowcat $ map (\x -> f x p) xs
slowspread :: (a -> t -> Pattern b) -> [a] -> t -> Pattern b
slowspread = spread
{- | @fastspread@ works the same as @spread@, but the result is squashed into a single cycle. If you gave four values to @spread@, then the result would seem to speed up by a factor of four. Compare these two:
d1 $ spread chop [4,64,32,16] $ sound "ho ho:2 ho:3 hc"
d1 $ fastspread chop [4,64,32,16] $ sound "ho ho:2 ho:3 hc"
There is also @slowspread@, which is an alias of @spread@.
-}
fastspread :: (a -> t -> Pattern b) -> [a] -> t -> Pattern b
fastspread f xs p = fastcat $ map (\x -> f x p) xs
{- | There's a version of this function, `spread'` (pronounced "spread prime"), which takes a *pattern* of parameters, instead of a list:
@
d1 $ spread' slow "2 4%3" $ sound "ho ho:2 ho:3 hc"
@
This is quite a messy area of Tidal - due to a slight difference of
implementation this sounds completely different! One advantage of
using `spread'` though is that you can provide polyphonic parameters, e.g.:
@
d1 $ spread' slow "[2 4%3, 3]" $ sound "ho ho:2 ho:3 hc"
@
-}
spread' :: Monad m => (a -> b -> m c) -> m a -> b -> m c
spread' f vpat pat = vpat >>= \v -> f v pat
{- | `spreadChoose f xs p` is similar to `slowspread` but picks values from
`xs` at random, rather than cycling through them in order. It has a
shorter alias `spreadr`.
-}
spreadChoose :: (t -> t1 -> Pattern b) -> [t] -> t1 -> Pattern b
spreadChoose f vs p = do v <- discretise 1 (choose vs)
f v p
spreadr :: (t -> t1 -> Pattern b) -> [t] -> t1 -> Pattern b
spreadr = spreadChoose
filterValues :: (a -> Bool) -> Pattern a -> Pattern a
filterValues f (Pattern x) = Pattern $ (filter (f . thd')) . x
filterJust :: Pattern (Maybe a) -> Pattern a
filterJust p = fromJust <$> (filterValues (isJust) p)
-- Filter out events that have had their onsets cut off
filterOnsets :: Pattern a -> Pattern a
filterOnsets (Pattern f) =
Pattern $ (filter (\e -> eventOnset e >= eventStart e)) . f
-- Filter events which have onsets, which are within the given range
-- TODO - what about < e ??
filterStartInRange :: Pattern a -> Pattern a
filterStartInRange (Pattern f) =
Pattern $ \(s,e) -> filter ((isIn (s,e)) . eventOnset) $ f (s,e)
filterOnsetsInRange :: Pattern a -> Pattern a
filterOnsetsInRange = filterOnsets . filterStartInRange
-- Samples some events from a pattern, returning a list of onsets
-- (relative to the given arc), deltas (durations) and values.
seqToRelOnsetDeltas :: Arc -> Pattern a -> [(Double, Double, a)]
seqToRelOnsetDeltas (s, e) p = map (\((s', e'), _, x) -> (fromRational $ (s'-s) / (e-s), fromRational $ (e'-s) / (e-s), x)) $ arc (filterOnsetsInRange p) (s, e)
segment :: Pattern a -> Pattern [a]
segment p = Pattern $ \(s,e) -> filter (\(_,(s',e'),_) -> s' < e && e' > s) $ groupByTime (segment' (arc p (s,e)))
segment' :: [Event a] -> [Event a]
segment' es = foldr split es pts
where pts = nub $ points es
split :: Time -> [Event a] -> [Event a]
split _ [] = []
split t ((ev@(a,(s,e), v)):es) | t > s && t < e = (a,(s,t),v):(a,(t,e),v):(split t es)
| otherwise = ev:split t es
points :: [Event a] -> [Time]
points [] = []
points ((_,(s,e), _):es) = s:e:(points es)
groupByTime :: [Event a] -> [Event [a]]
groupByTime es = map mrg $ groupBy ((==) `on` snd') $ sortBy (compare `on` snd') es
where mrg es@((a, a', _):_) = (a, a', map thd' es)
mrg _ = error "groupByTime"
{-| Decide whether to apply one or another function depending on the result of a test function that is passed the current cycle as a number.
@
d1 $ ifp ((== 0).(flip mod 2))
(striate 4)
(# coarse "24 48") $
sound "hh hc"
@
This will apply `striate 4` for every _even_ cycle and aply `# coarse "24 48"` for every _odd_.
Detail: As you can see the test function is arbitrary and does not rely on anything tidal specific. In fact it uses only plain haskell functionality, that is: it calculates the modulo of 2 of the current cycle which is either 0 (for even cycles) or 1. It then compares this value against 0 and returns the result, which is either `True` or `False`. This is what the `ifp` signature's first part signifies `(Int -> Bool)`, a function that takes a whole number and returns either `True` or `False`.
-}
ifp :: (Int -> Bool) -> (Pattern a -> Pattern a) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
ifp test f1 f2 p = splitQueries $ Pattern apply
where apply a | test (floor $ fst a) = (arc $ f1 p) a
| otherwise = (arc $ f2 p) a
{-|
`rand` generates a continuous pattern of (pseudo-)random, floating point numbers between `0` and `1`.
@
d1 $ sound "bd*8" # pan rand
@
pans bass drums randomly
@
d1 $ sound "sn sn ~ sn" # gain rand
@
makes the snares' randomly loud and quiet.
Numbers coming from this pattern are random, but dependent on time. So if you reset time via `cps (-1)` the random pattern will emit the exact same _random_ numbers again.
In cases where you need two different random patterns, you can shift one of them around to change the time from which the _random_ pattern is read, note the difference:
@
d1 $ jux (|+| gain rand) $ sound "sn sn ~ sn" # gain rand
@
and with the juxed version shifted backwards for 1024 cycles:
@
d1 $ jux (|+| ((1024 <~) $ gain rand)) $ sound "sn sn ~ sn" # gain rand
@
-}
rand :: Pattern Double
rand = Pattern $ \a -> [(a, a, timeToRand $ (midPoint a))]
timeToRand :: RealFrac r => r -> Double
timeToRand t = fst $ randomDouble $ pureMT $ floor $ (*1000000) t
{- | Just like `rand` but for whole numbers, `irand n` generates a pattern of (pseudo-) random whole numbers between `0` to `n-1` inclusive. Notably used to pick a random
samples from a folder:
@
d1 $ n (irand 5) # sound "drum"
@
-}
irand :: Num a => Int -> Pattern a
irand i = (fromIntegral . (floor :: Double -> Int) . (* (fromIntegral i))) <$> rand
{- | Randomly picks an element from the given list
@
d1 $ sound (samples "xx(3,8)" (tom $ choose ["a", "e", "g", "c"]))
@
plays a melody randomly choosing one of the four notes \"a\", \"e\", \"g\", \"c\".
-}
choose :: [a] -> Pattern a
choose [] = E.throw (E.ErrorCall "Empty list. Nothing to choose from.")
choose xs = (xs !!) <$> (irand $ length xs)
{- |
Similar to `degrade` `degradeBy` allows you to control the percentage of events that
are removed. For example, to remove events 90% of the time:
@
d1 $ slow 2 $ degradeBy 0.9 $ sound "[[[feel:5*8,feel*3] feel:3*8], feel*4]"
# accelerate "-6"
# speed "2"
@
-}
degradeBy :: Pattern Double -> Pattern a -> Pattern a
degradeBy = temporalParam _degradeBy
_degradeBy :: Double -> Pattern a -> Pattern a
_degradeBy x p = fmap fst $ filterValues ((> x) . snd) $ (,) <$> p <*> rand
unDegradeBy :: Pattern Double -> Pattern a -> Pattern a
unDegradeBy = temporalParam _unDegradeBy
_unDegradeBy :: Double -> Pattern a -> Pattern a
_unDegradeBy x p = fmap fst $ filterValues ((<= x) . snd) $ (,) <$> p <*> rand
degradeOverBy :: Int -> Pattern Double -> Pattern a -> Pattern a
degradeOverBy i tx p = unwrap $ (\x -> (fmap fst $ filterValues ((> x) . snd) $ (,) <$> p <*> repeatCycles i rand)) <$> (slow (fromIntegral i) tx)
{- | Use @sometimesBy@ to apply a given function "sometimes". For example, the
following code results in `density 2` being applied about 25% of the time:
@
d1 $ sometimesBy 0.25 (density 2) $ sound "bd*8"
@
There are some aliases as well:
@
sometimes = sometimesBy 0.5
often = sometimesBy 0.75
rarely = sometimesBy 0.25
almostNever = sometimesBy 0.1
almostAlways = sometimesBy 0.9
@
-}
sometimesBy :: Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimesBy x f p = overlay (_degradeBy x p) (f $ _unDegradeBy x p)
-- | @sometimes@ is an alias for sometimesBy 0.5.
sometimes :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimes = sometimesBy 0.5
-- | @often@ is an alias for sometimesBy 0.75.
often :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
often = sometimesBy 0.75
-- | @rarely@ is an alias for sometimesBy 0.25.
rarely :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
rarely = sometimesBy 0.25
-- | @almostNever@ is an alias for sometimesBy 0.1
almostNever :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
almostNever = sometimesBy 0.1
-- | @almostAlways@ is an alias for sometimesBy 0.9
almostAlways :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
almostAlways = sometimesBy 0.9
never :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
never = flip const
always :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
always = id
{- | @someCyclesBy@ is a cycle-by-cycle version of @sometimesBy@. It has a
`someCycles = someCyclesBy 0.5` alias -}
someCyclesBy :: Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
someCyclesBy x = when (test x)
where test x c = (timeToRand (fromIntegral c :: Double)) < x
somecyclesBy :: Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
somecyclesBy = someCyclesBy
someCycles :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
someCycles = someCyclesBy 0.5
{- | `degrade` randomly removes events from a pattern 50% of the time:
@
d1 $ slow 2 $ degrade $ sound "[[[feel:5*8,feel*3] feel:3*8], feel*4]"
# accelerate "-6"
# speed "2"
@
The shorthand syntax for `degrade` is a question mark: `?`. Using `?`
will allow you to randomly remove events from a portion of a pattern:
@
d1 $ slow 2 $ sound "bd ~ sn bd ~ bd? [sn bd?] ~"
@
You can also use `?` to randomly remove events from entire sub-patterns:
@
d1 $ slow 2 $ sound "[[[feel:5*8,feel*3] feel:3*8]?, feel*4]"
@
-}
degrade :: Pattern a -> Pattern a
degrade = _degradeBy 0.5
-- | @wedge t p p'@ combines patterns @p@ and @p'@ by squashing the
-- @p@ into the portion of each cycle given by @t@, and @p'@ into the
-- remainer of each cycle.
wedge :: Time -> Pattern a -> Pattern a -> Pattern a
wedge t p p' = overlay (densityGap (1/t) p) (t `rotR` densityGap (1/(1-t)) p')
timeCat :: [(Time, Pattern a)] -> Pattern a
timeCat tps = stack $ map (\(s,e,p) -> compress (s/total, e/total) p) $ arrange 0 tps
where total = sum $ map fst tps
arrange :: Time -> [(Time, Pattern a)] -> [(Time, Time, Pattern a)]
arrange _ [] = []
arrange t ((t',p):tps) = (t,t+t',p):(arrange (t+t') tps)
{- | @whenmod@ has a similar form and behavior to `every`, but requires an
additional number. Applies the function to the pattern, when the
remainder of the current loop number divided by the first parameter,
is greater or equal than the second parameter.
For example the following makes every other block of four loops twice
as dense:
@
d1 $ whenmod 8 4 (density 2) (sound "bd sn kurt")
@
-}
whenmod :: Int -> Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
whenmod a b = Sound.Tidal.Pattern.when ((\t -> (t `mod` a) >= b ))
{- |
@
superimpose f p = stack [p, f p]
@
`superimpose` plays a modified version of a pattern at the same time as the original pattern,
resulting in two patterns being played at the same time.
@
d1 $ superimpose (density 2) $ sound "bd sn [cp ht] hh"
d1 $ superimpose ((# speed "2") . (0.125 <~)) $ sound "bd sn cp hh"
@
-}
superimpose :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
superimpose f p = stack [p, f p]
-- | @splitQueries p@ wraps `p` to ensure that it does not get
-- queries that span arcs. For example `arc p (0.5, 1.5)` would be
-- turned into two queries, `(0.5,1)` and `(1,1.5)`, and the results
-- combined. Being able to assume queries don't span cycles often
-- makes transformations easier to specify.
splitQueries :: Pattern a -> Pattern a
splitQueries p = Pattern $ \a -> concatMap (arc p) $ arcCycles a
{- | @trunc@ truncates a pattern so that only a fraction of the pattern is played.
The following example plays only the first quarter of the pattern:
@
d1 $ trunc 0.25 $ sound "bd sn*2 cp hh*4 arpy bd*2 cp bd*2"
@
-}
trunc :: Pattern Time -> Pattern a -> Pattern a
trunc = temporalParam _trunc
_trunc :: Time -> Pattern a -> Pattern a
_trunc t = compress (0,t) . zoom (0,t)
{- | @linger@ is similar to `trunc` but the truncated part of the pattern loops until the end of the cycle
@
d1 $ linger 0.25 $ sound "bd sn*2 cp hh*4 arpy bd*2 cp bd*2"
@
-}
linger :: Pattern Time -> Pattern a -> Pattern a
linger = temporalParam _linger
_linger :: Time -> Pattern a -> Pattern a
_linger n p = _density (1/n) $ zoom (0,n) p
{- | Plays a portion of a pattern, specified by a beginning and end arc of time.
The new resulting pattern is played over the time period of the original pattern:
@
d1 $ zoom (0.25, 0.75) $ sound "bd*2 hh*3 [sn bd]*2 drum"
@
In the pattern above, `zoom` is used with an arc from 25% to 75%. It is equivalent to this pattern:
@
d1 $ sound "hh*3 [sn bd]*2"
@
-}
zoom :: Arc -> Pattern a -> Pattern a
zoom (s,e) p = splitQueries $ withResultArc (mapCycle ((/d) . (subtract s))) $ withQueryArc (mapCycle ((+s) . (*d))) p
where d = e-s
compress :: Arc -> Pattern a -> Pattern a
compress (s,e) p | s >= e = silence
| otherwise = s `rotR` densityGap (1/(e-s)) p
sliceArc :: Arc -> Pattern a -> Pattern a
sliceArc a@(s,e) p | s >= e = silence
| otherwise = compress a $ zoom a p
{- |
Use `within` to apply a function to only a part of a pattern. For example, to
apply `density 2` to only the first half of a pattern:
@
d1 $ within (0, 0.5) (density 2) $ sound "bd*2 sn lt mt hh hh hh hh"
@
Or, to apply `(# speed "0.5") to only the last quarter of a pattern:
@
d1 $ within (0.75, 1) (# speed "0.5") $ sound "bd*2 sn lt mt hh hh hh hh"
@
-}
within :: Arc -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
within (s,e) f p = stack [playWhen (\t -> cyclePos t >= s && cyclePos t < e) $ f p,
playWhen (\t -> not $ cyclePos t >= s && cyclePos t < e) $ p
]
revArc :: Arc -> Pattern a -> Pattern a
revArc a = within a rev
{- | You can use the @e@ function to apply a Euclidean algorithm over a
complex pattern, although the structure of that pattern will be lost:
@
d1 $ e 3 8 $ sound "bd*2 [sn cp]"
@
In the above, three sounds are picked from the pattern on the right according
to the structure given by the `e 3 8`. It ends up picking two `bd` sounds, a
`cp` and missing the `sn` entirely.
These types of sequences use "Bjorklund's algorithm", which wasn't made for
music but for an application in nuclear physics, which is exciting. More
exciting still is that it is very similar in structure to the one of the first
known algorithms written in Euclid's book of elements in 300 BC. You can read
more about this in the paper
[The Euclidean Algorithm Generates Traditional Musical Rhythms](http://cgm.cs.mcgill.ca/~godfried/publications/banff.pdf)
by Toussaint. Some examples from this paper are included below,
including rotation in some cases.
@
- (2,5) : A thirteenth century Persian rhythm called Khafif-e-ramal.
- (3,4) : The archetypal pattern of the Cumbia from Colombia, as well as a Calypso rhythm from Trinidad.
- (3,5,2) : Another thirteenth century Persian rhythm by the name of Khafif-e-ramal, as well as a Rumanian folk-dance rhythm.
- (3,7) : A Ruchenitza rhythm used in a Bulgarian folk-dance.
- (3,8) : The Cuban tresillo pattern.
- (4,7) : Another Ruchenitza Bulgarian folk-dance rhythm.
- (4,9) : The Aksak rhythm of Turkey.
- (4,11) : The metric pattern used by Frank Zappa in his piece titled Outside Now.
- (5,6) : Yields the York-Samai pattern, a popular Arab rhythm.
- (5,7) : The Nawakhat pattern, another popular Arab rhythm.
- (5,8) : The Cuban cinquillo pattern.
- (5,9) : A popular Arab rhythm called Agsag-Samai.
- (5,11) : The metric pattern used by Moussorgsky in Pictures at an Exhibition.
- (5,12) : The Venda clapping pattern of a South African children’s song.
- (5,16) : The Bossa-Nova rhythm necklace of Brazil.
- (7,8) : A typical rhythm played on the Bendir (frame drum).
- (7,12) : A common West African bell pattern.
- (7,16,14) : A Samba rhythm necklace from Brazil.
- (9,16) : A rhythm necklace used in the Central African Republic.
- (11,24,14) : A rhythm necklace of the Aka Pygmies of Central Africa.
- (13,24,5) : Another rhythm necklace of the Aka Pygmies of the upper Sangha.
@
-}
e :: Int -> Int -> Pattern a -> Pattern a
e n k p = (flip const) <$> (filterValues (== True) $ listToPat $ bjorklund (n,k)) <*> p
e' :: Int -> Int -> Pattern a -> Pattern a
e' n k p = fastcat $ map (\x -> if x then p else silence) (bjorklund (n,k))
index :: Real b => b -> Pattern b -> Pattern c -> Pattern c
index sz indexpat pat = spread' (zoom' $ toRational sz) (toRational . (*(1-sz)) <$> indexpat) pat
where zoom' sz start = zoom (start, start+sz)
-- | @prrw f rot (blen, vlen) beatPattern valuePattern@: pattern rotate/replace.
prrw :: (a -> b -> c) -> Int -> (Time, Time) -> Pattern a -> Pattern b -> Pattern c
prrw f rot (blen, vlen) beatPattern valuePattern =
let
ecompare (_,e1,_) (_,e2,_) = compare (fst e1) (fst e2)
beats = sortBy ecompare $ arc beatPattern (0, blen)
values = fmap thd' . sortBy ecompare $ arc valuePattern (0, vlen)
cycles = blen * (fromIntegral $ lcm (length beats) (length values) `div` (length beats))
in
_slow cycles $ stack $ zipWith
(\( _, (start, end), v') v -> (start `rotR`) $ densityGap (1 / (end - start)) $ pure (f v' v))
(sortBy ecompare $ arc (_density cycles $ beatPattern) (0, blen))
(drop (rot `mod` length values) $ cycle values)
-- | @prr rot (blen, vlen) beatPattern valuePattern@: pattern rotate/replace.
prr :: Int -> (Time, Time) -> Pattern String -> Pattern b -> Pattern b
prr = prrw $ flip const
{-|
@preplace (blen, plen) beats values@ combines the timing of @beats@ with the values
of @values@. Other ways of saying this are:
* sequential convolution
* @values@ quantized to @beats@.
Examples:
@
d1 $ sound $ preplace (1,1) "x [~ x] x x" "bd sn"
d1 $ sound $ preplace (1,1) "x(3,8)" "bd sn"
d1 $ sound $ "x(3,8)" <~> "bd sn"
d1 $ sound "[jvbass jvbass:5]*3" |+| (shape $ "1 1 1 1 1" <~> "0.2 0.9")
@
It is assumed the pattern fits into a single cycle. This works well with
pattern literals, but not always with patterns defined elsewhere. In those cases
use @preplace@ and provide desired pattern lengths:
@
let p = slow 2 $ "x x x"
d1 $ sound $ preplace (2,1) p "bd sn"
@
-}
preplace :: (Time, Time) -> Pattern String -> Pattern b -> Pattern b
preplace = preplaceWith $ flip const
-- | @prep@ is an alias for preplace.
prep :: (Time, Time) -> Pattern String -> Pattern b -> Pattern b
prep = preplace
preplace1 :: Pattern String -> Pattern b -> Pattern b
preplace1 = preplace (1, 1)
preplaceWith :: (a -> b -> c) -> (Time, Time) -> Pattern a -> Pattern b -> Pattern c
preplaceWith f (blen, plen) = prrw f 0 (blen, plen)
prw :: (a -> b -> c) -> (Time, Time) -> Pattern a -> Pattern b -> Pattern c
prw = preplaceWith
preplaceWith1 :: (a -> b -> c) -> Pattern a -> Pattern b -> Pattern c
preplaceWith1 f = prrw f 0 (1, 1)
prw1 :: (a -> b -> c) -> Pattern a -> Pattern b -> Pattern c
prw1 = preplaceWith1
(<~>) :: Pattern String -> Pattern b -> Pattern b
(<~>) = preplace (1, 1)
-- | @protate len rot p@ rotates pattern @p@ by @rot@ beats to the left.
-- @len@: length of the pattern, in cycles.
-- Example: @d1 $ every 4 (protate 2 (-1)) $ slow 2 $ sound "bd hh hh hh"@
protate :: Time -> Int -> Pattern a -> Pattern a
protate len rot p = prrw (flip const) rot (len, len) p p
prot :: Time -> Int -> Pattern a -> Pattern a
prot = protate
prot1 :: Int -> Pattern a -> Pattern a
prot1 = protate 1
{-| The @<<~@ operator rotates a unit pattern to the left, similar to @<~@,
but by events rather than linear time. The timing of the pattern remains constant:
@
d1 $ (1 <<~) $ sound "bd ~ sn hh"
-- will become
d1 $ sound "sn ~ hh bd"
@ -}
(<<~) :: Int -> Pattern a -> Pattern a
(<<~) = protate 1
-- | @~>>@ is like @<<~@ but for shifting to the right.
(~>>) :: Int -> Pattern a -> Pattern a
(~>>) = (<<~) . (0-)
-- | @pequal cycles p1 p2@: quickly test if @p1@ and @p2@ are the same.
pequal :: Ord a => Time -> Pattern a -> Pattern a -> Bool
pequal cycles p1 p2 = (sort $ arc p1 (0, cycles)) == (sort $ arc p2 (0, cycles))
-- | @discretise n p@: 'samples' the pattern @p@ at a rate of @n@
-- events per cycle. Useful for turning a continuous pattern into a
-- discrete one.
discretise :: Time -> Pattern a -> Pattern a
discretise n p = (_density n $ atom (id)) <*> p
discretise' = discretise
_discretise = discretise
-- | @randcat ps@: does a @slowcat@ on the list of patterns @ps@ but
-- randomises the order in which they are played.
randcat :: [Pattern a] -> Pattern a
randcat ps = spread' (rotL) (discretise 1 $ ((%1) . fromIntegral) <$> (irand (length ps) :: Pattern Int)) (slowcat ps)
-- @fromNote p@: converts a pattern of human-readable pitch names
-- into pitch numbers. For example, @"cs2"@ will be parsed as C Sharp
-- in the 2nd octave with the result of @11@, and @"b-3"@ as
-- @-25@. Pitches can be decorated using:
--
-- * s = Sharp, a half-step above (@"gs-1"@)
-- * f = Flat, a half-step below (@"gf-1"@)
-- * n = Natural, no decoration (@"g-1" and "gn-1"@ are equivalent)
-- * ss = Double sharp, a whole step above (@"gss-1"@)
-- * ff = Double flat, a whole step below (@"gff-1"@)
--
-- Note that TidalCycles now assumes that middle C is represented by
-- the value 0, rather than the previous value of 60. This function
-- is similar to previously available functions @tom@ and @toMIDI@,
-- but the default octave is now 0 rather than 5.
{-
definition moved to Parse.hs ..
toMIDI :: Pattern String -> Pattern Int
toMIDI p = fromJust <$> (filterValues (isJust) (noteLookup <$> p))
where
noteLookup :: String -> Maybe Int
noteLookup [] = Nothing
noteLookup s | not (last s `elem` ['0' .. '9']) = noteLookup (s ++ "0")
| not (isLetter (s !! 1)) = noteLookup((head s):'n':(tail s))
| otherwise = parse s
parse x = (\a b c -> a+b+c) <$> pc x <*> sym x <*> Just(12*digitToInt (last x))
pc x = lookup (head x) [('c',0),('d',2),('e',4),('f',5),('g',7),('a',9),('b',11)]
sym x = lookup (init (tail x)) [("s",1),("f",-1),("n",0),("ss",2),("ff",-2)]
-}
-- @tom p@: Alias for @toMIDI@.
-- tom = toMIDI
{- | The `fit` function takes a pattern of integer numbers, which are used to select values from the given list. What makes this a bit strange is that only a given number of values are selected each cycle. For example:
@
d1 $ sound (fit 3 ["bd", "sn", "arpy", "arpy:1", "casio"] "0 [~ 1] 2 1")
@
The above fits three samples into the pattern, i.e. for the first cycle this will be `"bd"`, `"sn"` and `"arpy"`, giving the result `"bd [~ sn] arpy sn"` (note that we start counting at zero, so that `0` picks the first value). The following cycle the *next* three values in the list will be picked, i.e. `"arpy:1"`, `"casio"` and `"bd"`, giving the pattern `"arpy:1 [~ casio] bd casio"` (note that the list wraps round here).
-}
fit :: Int -> [a] -> Pattern Int -> Pattern a
fit perCycle xs p = (xs !!!) <$> (Pattern $ \a -> map ((\e -> (mapThd' (+ (cyclePos perCycle e)) e))) (arc p a))
where cyclePos perCycle e = perCycle * (floor $ eventStart e)
permstep :: RealFrac b => Int -> [a] -> Pattern b -> Pattern a
permstep steps things p = unwrap $ (\n -> listToPat $ concatMap (\x -> replicate (fst x) (snd x)) $ zip (ps !! (floor (n * (fromIntegral $ (length ps - 1))))) things) <$> (discretise 1 p)
where ps = permsort (length things) steps
deviance avg xs = sum $ map (abs . (avg-) . fromIntegral) xs
permsort n total = map fst $ sortBy (comparing snd) $ map (\x -> (x,deviance (fromIntegral total / (fromIntegral n :: Double)) x)) $ perms n total
perms 0 _ = []
perms 1 n = [[n]]
perms n total = concatMap (\x -> map (x:) $ perms (n-1) (total-x)) [1 .. (total-(n-1))]
-- | @struct a b@: structures pattern @b@ in terms of @a@.
struct :: Pattern String -> Pattern a -> Pattern a
struct ps pv = (flip const) <$> ps <*> pv
-- | @substruct a b@: similar to @struct@, but each event in pattern @a@ gets replaced with pattern @b@, compressed to fit the timespan of the event.
substruct :: Pattern String -> Pattern b -> Pattern b
substruct s p = Pattern $ f
where f a = concatMap (\a' -> arc (compressTo a' p) a') $ (map fst' $ arc s a)
compressTo :: Arc -> Pattern a -> Pattern a
compressTo (s,e) p = compress (cyclePos s, e-(sam s)) p
randArcs :: Int -> Pattern [Arc]
randArcs n =
do rs <- mapM (\x -> (pure $ (toRational x)/(toRational n)) <~ choose [1,2,3]) [0 .. (n-1)]
let rats = map toRational rs
total = sum rats
pairs = pairUp $ accumulate $ map ((/total)) rats
return $ pairs
where pairUp [] = []
pairUp xs = (0,head xs):(pairUp' xs)
pairUp' [] = []
pairUp' (a:[]) = []
pairUp' (a:b:[]) = [(a,1)]
pairUp' (a:b:xs) = (a,b):(pairUp' (b:xs))
randStruct n = splitQueries $ Pattern f
where f (s,e) = mapSnds' fromJust $ filter (\(_,x,_) -> isJust x) $ as
where as = map (\(n, (s',e')) -> ((s' + sam s, e' + sam s),
subArc (s,e) (s' + sam s, e' + sam s),
n
)
) $ enumerate $ thd' $ head $ arc (randArcs n) (sam s, nextSam s)
substruct' :: Pattern Int -> Pattern a -> Pattern a
substruct' s p = Pattern $ \a -> concatMap (\(a', _, i) -> arc (compressTo a' (inside (pure $ 1/toRational(length (arc s (sam (fst a), nextSam (fst a))))) (rotR (toRational i)) p)) a') (arc s a)
-- | @stripe n p@: repeats pattern @p@, @n@ times per cycle. So
-- similar to @fast@, but with random durations. The repetitions will
-- be continguous (touching, but not overlapping) and the durations
-- will add up to a single cycle. @n@ can be supplied as a pattern of
-- integers.
stripe :: Pattern Int -> Pattern a -> Pattern a
stripe = temporalParam _stripe
_stripe :: Int -> Pattern a -> Pattern a
_stripe = substruct' . randStruct
-- | @slowstripe n p@: The same as @stripe@, but the result is also
-- @n@ times slower, so that the mean average duration of the stripes
-- is exactly one cycle, and every @n@th stripe starts on a cycle
-- boundary (in indian classical terms, the @sam@).
slowstripe :: Pattern Int -> Pattern a -> Pattern a
slowstripe n = slow (toRational <$> n) . stripe n
-- Lindenmayer patterns, these go well with the step sequencer
-- general rule parser (strings map to strings)
parseLMRule :: String -> [(String,String)]
parseLMRule s = map (splitOn ':') (commaSplit s)
where splitOn sep str = splitAt (fromJust $ elemIndex sep str)
$ filter (/= sep) str
commaSplit s = map T.unpack $ T.splitOn (T.pack ",") $ T.pack s
-- specific parser for step sequencer (chars map to string)
-- ruleset in form "a:b,b:ab"
parseLMRule' :: String -> [(Char, String)]
parseLMRule' str = map fixer $ parseLMRule str
where fixer (c,r) = (head c, r)
{- | returns the `n`th iteration of a [Lindenmayer System](https://en.wikipedia.org/wiki/L-system) with given start sequence.
for example:
@
lindenmayer 1 "a:b,b:ab" "ab" -> "bab"
@
-}
lindenmayer :: Int -> String -> String -> String
lindenmayer _ _ [] = []
lindenmayer 1 r (c:cs) = (fromMaybe [c] $ lookup c $ parseLMRule' r)
++ (lindenmayer 1 r cs)
lindenmayer n r s = iterate (lindenmayer 1 r) s !! n
-- support for fit'
unwrap' :: Pattern (Pattern a) -> Pattern a
unwrap' pp = Pattern $ \a -> arc (stack $ map scalep (arc pp a)) a
where scalep ev = compress (fst' ev) $ thd' ev
{-|
Removes events from second pattern that don't start during an event from first.
Consider this, kind of messy rhythm without any rests.
@
d1 $ sound (slowcat ["sn*8", "[cp*4 bd*4, hc*5]"]) # n (run 8)
@
If we apply a mask to it
@
d1 $ s (mask ("1 1 1 ~ 1 1 ~ 1" :: Pattern Bool)
(slowcat ["sn*8", "[cp*4 bd*4, bass*5]"] ))
# n (run 8)
@
Due to the use of `slowcat` here, the same mask is first applied to `"sn*8"` and in the next cycle to `"[cp*4 bd*4, hc*5]".
You could achieve the same effect by adding rests within the `slowcat` patterns, but mask allows you to do this more easily. It kind of keeps the rhythmic structure and you can change the used samples independently, e.g.
@
d1 $ s (mask ("1 ~ 1 ~ 1 1 ~ 1" :: Pattern Bool)
(slowcat ["can*8", "[cp*4 sn*4, jvbass*16]"] ))
# n (run 8)
@
Detail: It is currently needed to explicitly _tell_ Tidal that the mask itself is a `Pattern Bool` as it cannot infer this by itself, otherwise it will complain as it does not know how to interpret your input.
-}
mask :: Pattern a -> Pattern b -> Pattern b
mask pa pb = Pattern $ \a -> concat [filterOns (subArc a $ eventArc i) (arc pb a) | i <- arc pa a]
where filterOns Nothing _ = []
filterOns (Just arc) es = filter (onsetIn arc) es
enclosingArc :: [Arc] -> Arc
enclosingArc [] = (0,1)
enclosingArc as = (minimum (map fst as), maximum (map snd as))
stretch :: Pattern a -> Pattern a
stretch p = splitQueries $ Pattern $ \a@(s,_e) -> arc
(zoom (enclosingArc $ map eventArc $ arc p (sam s,nextSam s)) p)
a
{- | `fit'` is a generalization of `fit`, where the list is instead constructed by using another integer pattern to slice up a given pattern. The first argument is the number of cycles of that latter pattern to use when slicing. It's easier to understand this with a few examples:
@
d1 $ sound (fit' 1 2 "0 1" "1 0" "bd sn")
@
So what does this do? The first `1` just tells it to slice up a single cycle of `"bd sn"`. The `2` tells it to select two values each cycle, just like the first argument to `fit`. The next pattern `"0 1"` is the "from" pattern which tells it how to slice, which in this case means `"0"` maps to `"bd"`, and `"1"` maps to `"sn"`. The next pattern `"1 0"` is the "to" pattern, which tells it how to rearrange those slices. So the final result is the pattern `"sn bd"`.
A more useful example might be something like
@
d1 $ fit' 1 4 (run 4) "[0 3*2 2 1 0 3*2 2 [1*8 ~]]/2" $ chop 4 $ (sound "breaks152" # unit "c")
@
which uses `chop` to break a single sample into individual pieces, which `fit'` then puts into a list (using the `run 4` pattern) and reassembles according to the complicated integer pattern.
-}
fit' :: Pattern Time -> Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
fit' cyc n from to p = unwrap' $ fit n (mapMasks n from' p') to
where mapMasks n from p = [stretch $ mask (filterValues (== i) from) p
| i <- [0..n-1]]
p' = density cyc $ p
from' = density cyc $ from
{-| @chunk n f p@ treats the given pattern @p@ as having @n@ chunks, and applies the function @f@ to one of those sections per cycle, running from left to right.
@
d1 $ chunk 4 (density 4) $ sound "cp sn arpy [mt lt]"
@
-}
chunk :: Integer -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
chunk n f p = cat [within (i%(fromIntegral n),(i+1)%(fromIntegral n)) f p | i <- [0..n-1]]
{-
chunk n f p = do i <- _slow (toRational n) $ run (fromIntegral n)
within (i%(fromIntegral n),(i+)1%(fromIntegral n)) f p
-}
-- deprecated (renamed to chunk)
runWith :: Integer -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
runWith = chunk
{-| @chunk'@ works much the same as `chunk`, but runs from right to left.
-}
chunk' :: Integral a => a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
chunk' n f p = do i <- _slow (toRational n) $ rev $ run (fromIntegral n)
within (i%(fromIntegral n),(i+)1%(fromIntegral n)) f p
-- deprecated (renamed to chunk')
runWith' :: Integral a => a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
runWith' = chunk'
inside :: Pattern Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
inside n f p = density n $ f (slow n p)
outside :: Pattern Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
outside n = inside (1/n)
loopFirst :: Pattern a -> Pattern a
loopFirst p = splitQueries $ Pattern f
where f a@(s,_) = mapSnds' plus $ mapFsts' plus $ arc p (minus a)
where minus = mapArc (subtract (sam s))
plus = mapArc (+ (sam s))
timeLoop :: Pattern Time -> Pattern a -> Pattern a
timeLoop n = outside n loopFirst
seqPLoop :: [(Time, Time, Pattern a)] -> Pattern a
seqPLoop ps = timeLoop (pure $ maxT - minT) $ minT `rotL` seqP ps
where minT = minimum $ map fst' ps
maxT = maximum $ map snd' ps
{- | @toScale@ lets you turn a pattern of notes within a scale (expressed as a
list) to note numbers. For example `toScale [0, 4, 7] "0 1 2 3"` will turn
into the pattern `"0 4 7 12"`. It assumes your scale fits within an octave;
to change this use `toScale' size`. Example:
`toScale' 24 [0,4,7,10,14,17] (run 8)` turns into `"0 4 7 10 14 17 24 28"`
-}
toScale' :: Int -> [Int] -> Pattern Int -> Pattern Int
toScale' o s = fmap noteInScale
where octave x = x `div` length s
noteInScale x = (s !!! x) + o * octave x
toScale :: [Int] -> Pattern Int -> Pattern Int
toScale = toScale' 12
{- | `swingBy x n` divides a cycle into `n` slices and delays the notes in
the second half of each slice by `x` fraction of a slice . @swing@ is an alias
for `swingBy (1%3)`
-}
swingBy :: Pattern Time -> Pattern Time -> Pattern a -> Pattern a
swingBy x n = inside n (within (0.5,1) (x ~>))
swing :: Pattern Time -> Pattern a -> Pattern a
swing = swingBy (pure $ 1%3)
{- | `cycleChoose` is like `choose` but only picks a new item from the list
once each cycle -}
cycleChoose::[a] -> Pattern a
cycleChoose xs = Pattern $ \(s,e) -> [((s,e),(s,e), xs!!(floor $ (dlen xs)*(ctrand s) ))]
where dlen xs = fromIntegral $ length xs
ctrand s = (timeToRand :: Time -> Double) $ fromIntegral $ (floor :: Time -> Int) $ sam s
{- | `shuffle n p` evenly divides one cycle of the pattern `p` into `n` parts,
and returns a random permutation of the parts each cycle. For example,
`shuffle 3 "a b c"` could return `"a b c"`, `"a c b"`, `"b a c"`, `"b c a"`,
`"c a b"`, or `"c b a"`. But it will **never** return `"a a a"`, because that
is not a permutation of the parts.
-}
shuffle::Int -> Pattern a -> Pattern a
shuffle n = fit' 1 n (_run n) (randpat n)
where randpat n = Pattern $ \(s,e) -> arc (p n $ sam s) (s,e)
p n c = listToPat $ map snd $ sort $ zip
[timeToRand (c+i/n') | i <- [0..n'-1]] [0..n-1]
n' :: Time
n' = fromIntegral n
{- | `scramble n p` is like `shuffle` but randomly selects from the parts
of `p` instead of making permutations.
For example, `scramble 3 "a b c"` will randomly select 3 parts from
`"a"` `"b"` and `"c"`, possibly repeating a single part.
-}
scramble::Int -> Pattern a -> Pattern a
scramble n = fit' 1 n (_run n) (_density (fromIntegral n) $
liftA2 (+) (pure 0) $ irand n)
ur :: Time -> Pattern String -> [Pattern a] -> Pattern a
ur t outer_p ps = _slow t $ unwrap $ adjust <$> (timedValues $ (getPat . split) <$> outer_p)
where split s = wordsBy (==':') s
getPat (n:xs) = (ps' !!! read n, transform xs)
ps' = map (_density t) ps
adjust (a, (p, f)) = f a p
transform (x:_) a = transform' x a
transform _ _ = id
transform' "in" (s,e) p = twiddle (fadeIn) (s,e) p
transform' "out" (s,e) p = twiddle (fadeOut) (s,e) p
transform' _ _ p = p
twiddle f (s,e) p = s `rotR` (f (e-s) p)
ur' :: Time -> Pattern String -> [(String, Pattern a)] -> [(String, Pattern a -> Pattern a)] -> Pattern a
ur' t outer_p ps fs = _slow t $ unwrap $ adjust <$> (timedValues $ (getPat . split) <$> outer_p)
where split s = wordsBy (==':') s
getPat (s:xs) = (match s, transform xs)
match s = fromMaybe silence $ lookup s ps'
ps' = map (fmap (_density t)) ps
adjust (a, (p, f)) = f a p
transform (x:_) a = transform' x a
transform _ _ = id
transform' str (s,e) p = s `rotR` (inside (pure $ 1/(e-s)) (matchF str) p)
matchF str = fromMaybe id $ lookup str fs
inhabit :: [(String, Pattern a)] -> Pattern String -> Pattern a
inhabit ps p = unwrap' $ (\s -> fromMaybe silence $ lookup s ps) <$> p
repeatCycles :: Int -> Pattern a -> Pattern a
repeatCycles n p = fastcat (replicate n p)
{- | @spaceOut xs p@ repeats a pattern @p@ at different durations given by the list of time values in @xs@ -}
spaceOut :: [Time] -> Pattern a -> Pattern a
spaceOut xs p = _slow (toRational $ sum xs) $ stack $ map (\a -> compress a p) $ spaceArcs xs
where markOut :: Time -> [Time] -> [(Time, Time)]
markOut _ [] = []
markOut offset (x:xs) = (offset,offset+x):(markOut (offset+x) xs)
spaceArcs xs = map (\(a,b) -> (a/s,b/s)) $ markOut 0 xs
s = sum xs
-- | @flatpat@ takes a Pattern of lists and pulls the list elements as
-- separate Events
flatpat :: Pattern [a] -> Pattern a
flatpat p = Pattern $ \a -> (concatMap (\(b,b',xs) -> map (\x -> (b,b',x)) xs) $ arc p a)
-- | @layer@ takes a Pattern of lists and pulls the list elements as
-- separate Events
layer :: [a -> Pattern b] -> a -> Pattern b
layer fs p = stack $ map ($ p) fs
-- | @breakUp@ finds events that share the same timespan, and spreads them out during that timespan, so for example @breakUp "[bd,sn]"@ gets turned into @"bd sn"@
breakUp :: Pattern a -> Pattern a
breakUp p = Pattern $ \a -> munge $ arc p a
where munge es = concatMap spreadOut (groupBy (\a b -> fst' a == fst' b) es)
spreadOut xs = catMaybes $ map (\(n, x) -> shiftIt n (length xs) x) $ enumerate xs
shiftIt n d ((s,e), a', v) = do a'' <- subArc (newS, newE) a'
return ((newS, newE), a'', v)
where newS = s + (dur*(fromIntegral n))
newE = newS + dur
dur = (e - s) / (fromIntegral d)
-- | @fill@ 'fills in' gaps in one pattern with events from another. For example @fill "bd" "cp ~ cp"@ would result in the equivalent of `"~ bd ~"`. This only finds gaps in a resulting pattern, in other words @"[bd ~, sn]"@ doesn't contain any gaps (because @sn@ covers it all), and @"bd ~ ~ sn"@ only contains a single gap that bridges two steps.
fill :: Pattern a -> Pattern a -> Pattern a
fill p' p = struct (splitQueries $ Pattern (f p)) p'
where
f p (s,e) = removeTolerance (s,e) $ invert (s-tolerance, e+tolerance) $ arc p (s-tolerance, e+tolerance)
invert (s,e) es = map arcToEvent $ foldr remove [(s,e)] (map snd' es)
remove (s,e) xs = concatMap (remove' (s, e)) xs
remove' (s,e) (s',e') | s > s' && e < e' = [(s',s),(e,e')] -- inside
| s > s' && s < e' = [(s',s)] -- cut off right
| e > s' && e < e' = [(e,e')] -- cut off left
| s <= s' && e >= e' = [] -- swallow
| otherwise = [(s',e')] -- miss
arcToEvent a = (a,a,"x")
removeTolerance (s,e) es = concatMap (expand) $ mapSnds' f es
where f (a) = concatMap (remove' (e,e+tolerance)) $ remove' (s-tolerance,s) a
expand (a,xs,c) = map (\x -> (a,x,c)) xs
tolerance = 0.01
tidal-0.9.5/Sound/Tidal/Tempo.hs 0000644 0000000 0000000 00000033143 13212576414 014566 0 ustar 00 0000000 0000000 {-# LANGUAGE ScopedTypeVariables #-}
module Sound.Tidal.Tempo where
import Data.Time (getCurrentTime, UTCTime, NominalDiffTime, diffUTCTime, addUTCTime)
import Data.Time.Clock.POSIX
import Control.Applicative ((<$>), (<*>))
import Control.Monad (forM_, forever, void)
--import Control.Monad.IO.Class (liftIO)
import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.MVar
import Control.Monad.Trans (liftIO)
import Data.Maybe (fromMaybe, maybe, isJust, fromJust)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Unique
import qualified Network.WebSockets as WS
import qualified Control.Exception as E
import Safe (readNote)
import System.Environment (lookupEnv)
import qualified System.IO.Error as Error
import GHC.Conc.Sync (ThreadId)
import Sound.OSC.FD
import Sound.Tidal.Utils
data Tempo = Tempo {at :: UTCTime, beat :: Double, cps :: Double, paused :: Bool, clockLatency :: Double}
type ClientState = [TConnection]
data ServerMode = Master
| Slave UDP
instance Show ServerMode where
show Master = "Master"
show _ = "Slave"
data TConnection = TConnection Unique WS.Connection
wsConn :: TConnection -> WS.Connection
wsConn (TConnection _ c) = c
instance Eq TConnection where
TConnection a _ == TConnection b _ = a == b
instance Show Tempo where
show x = show (at x) ++ "," ++ show (beat x) ++ "," ++ show (cps x) ++ "," ++ show (paused x) ++ "," ++ (show $ clockLatency x)
getLatency :: IO Double
getLatency =
maybe 0.04 (readNote "latency parse") <$> lookupEnv "TIDAL_CLOCK_LATENCY"
getClockIp :: IO String
getClockIp = fromMaybe "127.0.0.1" <$> lookupEnv "TIDAL_TEMPO_IP"
getServerPort :: IO Int
getServerPort =
maybe 9160 (readNote "port parse") <$> lookupEnv "TIDAL_TEMPO_PORT"
getMasterPort :: IO Int
getMasterPort =
maybe 6042 (readNote "port parse") <$> lookupEnv "TIDAL_MASTER_PORT"
getSlavePort :: IO Int
getSlavePort =
maybe 6043 (readNote "port parse") <$> lookupEnv "TIDAL_SLAVE_PORT"
readTempo :: String -> Tempo
readTempo x = Tempo (read a) (read b) (read c) (read d) (read e)
where (a:b:c:d:e:_) = wordsBy (== ',') x
logicalTime :: Tempo -> Double -> Double
logicalTime t b = changeT + timeDelta
where beatDelta = b - (beat t)
timeDelta = beatDelta / (cps t)
changeT = realToFrac $ utcTimeToPOSIXSeconds $ at t
tempoMVar :: IO (MVar (Tempo))
tempoMVar = do now <- getCurrentTime
l <- getLatency
mv <- newMVar (Tempo now 0 0.5 False l)
forkIO $ clocked $ f mv
return mv
where f mv change _ = do swapMVar mv change
return ()
beatNow :: Tempo -> IO (Double)
beatNow t = do now <- getCurrentTime
let delta = realToFrac $ diffUTCTime now (at t)
let beatDelta = cps t * delta
return $ beat t + beatDelta
clientApp :: MVar Tempo -> MVar Double -> MVar Double -> WS.ClientApp ()
clientApp mTempo mCps mNudge conn = do
liftIO $ forkIO $ sendCps conn mCps
liftIO $ forkIO $ sendNudge conn mNudge
forever loop
where
loop = do
msg <- WS.receiveData conn
let s = T.unpack msg
let tempo = readTempo $ s
old <- liftIO $ tryTakeMVar mTempo
-- putStrLn $ "from: " ++ show old
-- putStrLn $ "to: " ++ show tempo
liftIO $ putMVar mTempo tempo
sendTempo :: [WS.Connection] -> Tempo -> IO ()
sendTempo conns t = mapM_ (\conn -> WS.sendTextData conn (T.pack $ show t)) conns
sendCps :: WS.Connection -> MVar Double -> IO ()
sendCps conn mCps = forever $ do cps <- takeMVar mCps
let m = "cps " ++ (show cps)
WS.sendTextData conn (T.pack m)
sendNudge :: WS.Connection -> MVar Double -> IO ()
sendNudge conn mNudge = forever $ do nudge <- takeMVar mNudge
let m = "nudge " ++ (show nudge)
WS.sendTextData conn (T.pack m)
connectClient :: Bool -> String -> MVar Tempo -> MVar Double -> MVar Double -> IO ()
connectClient secondTry ip mTempo mCps mNudge = do
let errMsg = "Failed to connect to tidal server. Try specifying a " ++
"different port (default is 9160) setting the " ++
"environment variable TIDAL_TEMPO_PORT"
serverPort <- getServerPort
WS.runClient ip serverPort "/tempo" (clientApp mTempo mCps mNudge) `E.catch`
\(_ :: E.SomeException) -> do
case secondTry of
True -> error errMsg
_ -> do
res <- E.try (void startServer)
case res of
Left (_ :: E.SomeException) -> error errMsg
Right _ -> do
threadDelay 500000
connectClient True ip mTempo mCps mNudge
runClient :: IO ((MVar Tempo, MVar Double, MVar Double))
runClient =
do clockip <- getClockIp
mTempo <- newEmptyMVar
mCps <- newEmptyMVar
mNudge <- newEmptyMVar
forkIO $ connectClient False clockip mTempo mCps mNudge
return (mTempo, mCps, mNudge)
cpsUtils' :: IO ((Double -> IO (), (Double -> IO ()), IO Rational))
cpsUtils' = do (mTempo, mCps, mNudge) <- runClient
let cpsSetter = putMVar mCps
nudger = putMVar mNudge
currentTime = do tempo <- readMVar mTempo
now <- beatNow tempo
return $ toRational now
return (cpsSetter, nudger, currentTime)
-- backward compatibility
cpsUtils = do (cpsSetter, _, currentTime) <- cpsUtils'
return (cpsSetter, currentTime)
-- Backwards compatibility
bpsUtils :: IO ((Double -> IO (), IO (Rational)))
bpsUtils = cpsUtils
cpsSetter :: IO (Double -> IO ())
cpsSetter = do (f, _) <- cpsUtils
return f
clocked :: (Tempo -> Int -> IO ()) -> IO ()
clocked = clockedTick 1
clockedTick :: Int -> (Tempo -> Int -> IO ()) -> IO ()
clockedTick tpb callback =
do (mTempo, _, mCps) <- runClient
t <- readMVar mTempo
now <- getCurrentTime
let delta = realToFrac $ diffUTCTime now (at t)
beatDelta = cps t * delta
nowBeat = beat t + beatDelta
nextTick = ceiling (nowBeat * (fromIntegral tpb))
-- next4 = nextBeat + (4 - (nextBeat `mod` 4))
loop mTempo nextTick
where loop mTempo tick =
do tempo <- readMVar mTempo
tick' <- doTick tempo tick
loop mTempo tick'
doTick tempo tick | paused tempo =
do let pause = 0.01
-- TODO - do this via blocking read on the mvar somehow
-- rather than polling
threadDelay $ floor (pause * 1000000)
-- reset tick to 0 if cps is negative
return $ if cps tempo < 0 then 0 else tick
| otherwise =
do now <- getCurrentTime
let tps = (fromIntegral tpb) * cps tempo
delta = realToFrac $ diffUTCTime now (at tempo)
actualTick = ((fromIntegral tpb) * beat tempo) + (tps * delta)
-- only wait by up to two ticks
tickDelta = min 2 $ (fromIntegral tick) - actualTick
delay = tickDelta / tps
-- putStrLn $ "tick delta: " ++ show tickDelta
--putStrLn ("Delay: " ++ show delay ++ "s Beat: " ++ show (beat tempo))
threadDelay $ floor (delay * 1000000)
callback tempo tick
-- putStrLn $ "hmm diff: " ++ show (abs $ (floor actualTick) - tick)
let newTick | (abs $ (floor actualTick) - tick) > 4 = floor actualTick
| otherwise = tick + 1
return $ newTick
updateTempo :: Tempo -> Double -> IO (Tempo)
updateTempo t cps'
| paused t == True && cps' > 0 =
-- unpause
do now <- getCurrentTime
return $ t {at = addUTCTime (realToFrac $ clockLatency t) now, cps = cps', paused = False}
| otherwise =
do now <- getCurrentTime
let delta = realToFrac $ diffUTCTime now (at t)
beat' = (beat t) + ((cps t) * delta)
beat'' = if cps' < 0 then 0 else beat'
return $ t {at = now, beat = beat'', cps = cps', paused = (cps' <= 0)}
nudgeTempo :: Tempo -> Double -> Tempo
nudgeTempo t secs = t {at = addUTCTime (realToFrac secs) (at t)}
removeClient :: TConnection -> ClientState -> ClientState
removeClient client = filter (/= client)
broadcast :: Text -> ClientState -> IO ()
broadcast message clients = do
-- T.putStrLn message
forM_ clients $ \conn -> WS.sendTextData (wsConn conn) $ message
startServer :: IO (ThreadId)
startServer = do
serverPort <- getServerPort
start <- getCurrentTime
l <- getLatency
tempoState <- newMVar (Tempo start 0 1 False l)
clientState <- newMVar []
serverState <- newMVar Master
--liftIO $ oscBridge clientState
liftIO $ slave serverState clientState
forkIO $ WS.runServer "0.0.0.0" serverPort $ serverApp tempoState serverState clientState
serverApp :: MVar Tempo -> MVar ServerMode -> MVar ClientState -> WS.ServerApp
serverApp tempoState serverState clientState pending = do
conn <- TConnection <$> newUnique <*> WS.acceptRequest pending
tempo <- liftIO $ readMVar tempoState
liftIO $ WS.sendTextData (wsConn conn) $ T.pack $ show tempo
clients <- liftIO $ readMVar clientState
liftIO $ modifyMVar_ clientState $ return . (conn:)
serverLoop conn tempoState serverState clientState
slave :: MVar ServerMode -> MVar ClientState -> IO ()
slave serverState clientState =
do slavePort <- getSlavePort
slaveSock <- udpServer "127.0.0.1" (fromIntegral slavePort)
_ <- forkIO $ loop slaveSock
return ()
where loop slaveSock =
do ms <- recvMessages slaveSock
mapM_ (\m -> slaveAct (messageAddress m) serverState clientState m) ms
loop slaveSock
slaveAct :: String -> MVar ServerMode -> MVar ClientState -> Message -> IO ()
slaveAct "/tempo" serverState clientState m
| isJust t = do clients <- readMVar clientState
setSlave serverState
sendTempo (map wsConn clients) (fromJust t)
| otherwise = return ()
where t = do beat' <- datum_floating $ (messageDatum m) !! 2
cps' <- datum_floating $ (messageDatum m) !! 3
return $ Tempo {at = ut,
beat = beat',
cps = cps',
paused = False,
clockLatency = 0
}
ut = addUTCTime (realToFrac $ dsec) ut_epoch
sec = fromJust $ datum_int32 $ (messageDatum m) !! 0
usec = fromJust $ datum_int32 $ (messageDatum m) !! 1
dsec = ((fromIntegral sec) + ((fromIntegral usec) / 1000000)) :: Double
setSlave :: MVar ServerMode -> IO ()
setSlave serverState = do s <- takeMVar serverState
s' <- updateState s
putMVar serverState s'
return ()
where updateState Master = do putStrLn "Slaving tempo.."
masterPort <- getMasterPort
sock <- openUDP "127.0.0.1" (fromIntegral masterPort)
return (Slave sock)
-- already slaving..
updateState s = return s
serverLoop :: TConnection -> MVar Tempo -> MVar ServerMode -> MVar ClientState -> IO ()
serverLoop conn tempoState serverState clientState = E.handle catchDisconnect $
forever $ do
msg <- WS.receiveData $ wsConn conn
--liftIO $ updateTempo tempoState $ maybeRead $ T.unpack msg
mode <- readMVar serverState
serverAct (T.unpack msg) mode tempoState clientState
--
--tempo <- liftIO $ readMVar tempoState
-- liftIO $ readMVar clientState >>= broadcast (T.pack $ show tempo)
where
catchDisconnect e = case E.fromException e of
Just WS.ConnectionClosed -> liftIO $ modifyMVar_ clientState $ \s -> do
let s' = removeClient conn s
return s'
_ -> return ()
serverAct :: String -> ServerMode -> MVar Tempo -> MVar ClientState -> IO ()
serverAct ('c':'p':'s':' ':n) mode tempoState clientState = setCps (read n) mode tempoState clientState
serverAct ('n':'u':'d':'g':'e':' ':n) mode tempoState clientState = setNudge (read n) mode tempoState clientState
serverAct s _ _ _ = do putStrLn $ "tempo server received unknown message " ++ s
return ()
setCps :: Double -> ServerMode -> MVar Tempo -> MVar ClientState -> IO ()
setCps n Master tempoState clientState = do tempo <- takeMVar tempoState
tempo' <- updateTempo tempo (n :: Double)
clients <- readMVar clientState
sendTempo (map wsConn clients) (tempo')
putMVar tempoState tempo'
return ()
setCps n (Slave sock) tempoState clientState = sendOSC sock $ Message "/cps" [Float (realToFrac n)]
setNudge :: Double -> ServerMode -> MVar Tempo -> MVar ClientState -> IO ()
setNudge n Master tempoState clientState = do tempo <- takeMVar tempoState
let tempo' = nudgeTempo tempo n
clients <- readMVar clientState
sendTempo (map wsConn clients) (tempo')
putMVar tempoState tempo'
return ()
setNudge n (Slave sock) tempoState clientState = sendOSC sock $ Message "/nudge" [Float (realToFrac n)]
tidal-0.9.5/Sound/Tidal/Parse.hs 0000644 0000000 0000000 00000033144 13212576414 014555 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
module Sound.Tidal.Parse where
import Text.ParserCombinators.Parsec
import qualified Text.ParserCombinators.Parsec.Token as P
import Text.ParserCombinators.Parsec.Language ( haskellDef )
import Data.Ratio
import Data.Colour
import Data.Colour.Names
import Data.Colour.SRGB
import GHC.Exts( IsString(..) )
import Data.Monoid
import Control.Exception as E
import Control.Applicative ((<$>), (<*>), pure)
import Data.Maybe
import Data.List
import Sound.Tidal.Pattern
import Sound.Tidal.Time (Arc, Time)
-- | AST representation of patterns
data TPat a = TPat_Atom a
| TPat_Density Time (TPat a)
| TPat_Slow Time (TPat a)
| TPat_Zoom Arc (TPat a)
| TPat_DegradeBy Double (TPat a)
| TPat_Silence
| TPat_Foot
| TPat_Elongate Int
| TPat_EnumFromTo (TPat a) (TPat a)
| TPat_Cat [TPat a]
| TPat_TimeCat [TPat a]
| TPat_Overlay (TPat a) (TPat a)
| TPat_ShiftL Time (TPat a)
-- TPat_E Int Int (TPat a)
| TPat_pE (TPat Int) (TPat Int) (TPat Integer) (TPat a)
deriving (Show)
instance Parseable a => Monoid (TPat a) where
mempty = TPat_Silence
mappend = TPat_Overlay
toPat :: Parseable a => TPat a -> Pattern a
toPat = \case
TPat_Atom x -> atom x
TPat_Density t x -> _density t $ toPat x
TPat_Slow t x -> _slow t $ toPat x
TPat_Zoom arc x -> zoom arc $ toPat x
TPat_DegradeBy amt x -> _degradeBy amt $ toPat x
TPat_Silence -> silence
TPat_Cat xs -> fastcat $ map toPat xs
TPat_TimeCat xs -> timeCat $ map (\(n, p) -> (toRational n, toPat p)) $ durations xs
TPat_Overlay x0 x1 -> overlay (toPat x0) (toPat x1)
TPat_ShiftL t x -> t `rotL` toPat x
TPat_pE n k s thing ->
unwrap $ eoff <$> toPat n <*> toPat k <*> toPat s <*> pure (toPat thing)
TPat_Foot -> error "Can't happen, feet (.'s) only used internally.."
TPat_EnumFromTo a b -> unwrap $ fromTo <$> (toPat a) <*> (toPat b)
-- TPat_EnumFromThenTo a b c -> unwrap $ fromThenTo <$> (toPat a) <*> (toPat b) <*> (toPat c)
durations :: [TPat a] -> [(Int, TPat a)]
durations [] = []
durations ((TPat_Elongate n):xs) = (n, TPat_Silence):(durations xs)
durations (a:(TPat_Elongate n):xs) = (n+1,a):(durations xs)
durations (a:xs) = (1,a):(durations xs)
p :: Parseable a => String -> Pattern a
p = toPat . parseTPat
class Parseable a where
parseTPat :: String -> TPat a
fromTo :: a -> a -> Pattern a
fromThenTo :: a -> a -> a -> Pattern a
instance Parseable Double where
parseTPat = parseRhythm pDouble
fromTo a b = enumFromTo' a b
fromThenTo a b c = enumFromThenTo' a b c
instance Parseable String where
parseTPat = parseRhythm pVocable
fromTo a b = listToPat [a,b]
fromThenTo a b c = listToPat [a,b,c]
instance Parseable Bool where
parseTPat = parseRhythm pBool
fromTo a b = listToPat [a,b]
fromThenTo a b c = listToPat [a,b,c]
instance Parseable Int where
parseTPat = parseRhythm pIntegral
fromTo a b = enumFromTo' a b
fromThenTo a b c = enumFromThenTo' a b c
instance Parseable Integer where
parseTPat s = parseRhythm pIntegral s
fromTo a b = enumFromTo' a b
fromThenTo a b c = enumFromThenTo' a b c
instance Parseable Rational where
parseTPat = parseRhythm pRational
fromTo a b = enumFromTo' a b
fromThenTo a b c = enumFromThenTo' a b c
enumFromTo' a b | a > b = listToPat $ reverse $ enumFromTo b a
| otherwise = listToPat $ enumFromTo a b
enumFromThenTo' a b c | a > c = listToPat $ reverse $ enumFromThenTo c (c + (a-b)) a
| otherwise = listToPat $ enumFromThenTo a b c
type ColourD = Colour Double
instance Parseable ColourD where
parseTPat = parseRhythm pColour
fromTo a b = listToPat [a,b]
fromThenTo a b c = listToPat [a,b,c]
instance (Parseable a) => IsString (Pattern a) where
fromString = toPat . parseTPat
--instance (Parseable a, Pattern p) => IsString (p a) where
-- fromString = p :: String -> p a
lexer = P.makeTokenParser haskellDef
braces, brackets, parens, angles:: Parser a -> Parser a
braces = P.braces lexer
brackets = P.brackets lexer
parens = P.parens lexer
angles = P.angles lexer
symbol :: String -> Parser String
symbol = P.symbol lexer
natural, integer :: Parser Integer
natural = P.natural lexer
integer = P.integer lexer
float :: Parser Double
float = P.float lexer
naturalOrFloat :: Parser (Either Integer Double)
naturalOrFloat = P.naturalOrFloat lexer
data Sign = Positive | Negative
applySign :: Num a => Sign -> a -> a
applySign Positive = id
applySign Negative = negate
sign :: Parser Sign
sign = do char '-'
return Negative
<|> do char '+'
return Positive
<|> return Positive
intOrFloat :: Parser (Either Integer Double)
intOrFloat = do s <- sign
num <- naturalOrFloat
return (case num of
Right x -> Right (applySign s x)
Left x -> Left (applySign s x)
)
r :: Parseable a => String -> Pattern a -> IO (Pattern a)
r s orig = do E.handle
(\err -> do putStrLn (show (err :: E.SomeException))
return orig
)
(return $ p s)
parseRhythm :: Parseable a => Parser (TPat a) -> String -> TPat a
parseRhythm f input = either (const TPat_Silence) id $ parse (pSequence f') "" input
where f' = f
<|> do symbol "~" "rest"
return TPat_Silence
pSequenceN :: Parseable a => Parser (TPat a) -> GenParser Char () (Int, TPat a)
pSequenceN f = do spaces
-- d <- pDensity
ps <- many $ do a <- pPart f
do Text.ParserCombinators.Parsec.try $ symbol ".."
b <- pPart f
return [TPat_EnumFromTo (TPat_Cat a) (TPat_Cat b)]
<|> return a
<|> do symbol "."
return [TPat_Foot]
<|> do es <- many1 (symbol "_")
return [TPat_Elongate (length es)]
let ps' = TPat_Cat $ map elongate $ splitFeet $ concat ps
return (length ps, ps')
elongate xs | any (isElongate) xs = TPat_TimeCat xs
| otherwise = TPat_Cat xs
where isElongate (TPat_Elongate _) = True
isElongate _ = False
{-
expandEnum :: Parseable t => Maybe (TPat t) -> [TPat t] -> [TPat t]
expandEnum a [] = [a]
expandEnum (Just a) (TPat_Enum:b:ps) = (TPat_EnumFromTo a b) : (expandEnum Nothing ps)
-- ignore ..s in other places
expandEnum a (TPat_Enum:ps) = expandEnum a ps
expandEnum (Just a) (b:ps) = a:(expandEnum b (Just c) ps)
expandEnum Nothing (c:ps) = expandEnum (Just c) ps
-}
-- could use splitOn here but `TPat a` isn't a member of `EQ`..
splitFeet :: [TPat t] -> [[TPat t]]
splitFeet [] = []
splitFeet ps = foot:(splitFeet ps')
where (foot, ps') = takeFoot ps
takeFoot [] = ([], [])
takeFoot (TPat_Foot:ps) = ([], ps)
takeFoot (p:ps) = (\(a,b) -> (p:a,b)) $ takeFoot ps
pSequence :: Parseable a => Parser (TPat a) -> GenParser Char () (TPat a)
pSequence f = do (_, p) <- pSequenceN f
return p
pSingle :: Parseable a => Parser (TPat a) -> Parser (TPat a)
pSingle f = f >>= pRand >>= pMult
pPart :: Parseable a => Parser (TPat a) -> Parser [TPat a]
pPart f = do part <- pSingle f <|> pPolyIn f <|> pPolyOut f
part <- pE part
part <- pRand part
spaces
parts <- pStretch part
<|> pReplicate part
spaces
return $ parts
pPolyIn :: Parseable a => Parser (TPat a) -> Parser (TPat a)
pPolyIn f = do ps <- brackets (pSequence f `sepBy` symbol ",")
spaces
pMult $ mconcat ps
pPolyOut :: Parseable a => Parser (TPat a) -> Parser (TPat a)
pPolyOut f = do ps <- braces (pSequenceN f `sepBy` symbol ",")
spaces
base <- do char '%'
spaces
i <- integer "integer"
return $ Just (fromIntegral i)
<|> return Nothing
pMult $ mconcat $ scale base ps
<|>
do ps <- angles (pSequenceN f `sepBy` symbol ",")
spaces
pMult $ mconcat $ scale (Just 1) ps
where scale _ [] = []
scale base (ps@((n,_):_)) = map (\(n',p) -> TPat_Density (fromIntegral (fromMaybe n base)/ fromIntegral n') p) ps
pString :: Parser (String)
pString = do c <- (letter <|> oneOf "0123456789") "charnum"
cs <- many (letter <|> oneOf "0123456789:.-_") "string"
return (c:cs)
pVocable :: Parser (TPat String)
pVocable = do v <- pString
return $ TPat_Atom v
pDouble :: Parser (TPat Double)
pDouble = do nf <- intOrFloat "float"
let f = either fromIntegral id nf
return $ TPat_Atom f
pBool :: Parser (TPat Bool)
pBool = do oneOf "t1"
return $ TPat_Atom True
<|>
do oneOf "f0"
return $ TPat_Atom False
parseIntNote :: Integral i => Parser i
parseIntNote = do s <- sign
i <- choice [integer, parseNote]
return $ applySign s $ fromIntegral i
parseInt :: Parser Int
parseInt = do s <- sign
i <- integer
return $ applySign s $ fromIntegral i
pIntegral :: Parseable a => Integral a => Parser (TPat a)
pIntegral = TPat_Atom <$> parseIntNote
parseNote :: Integral a => Parser a
parseNote = do n <- notenum
modifiers <- many noteModifier
octave <- option 5 natural
let n' = foldr (+) n modifiers
return $ fromIntegral $ n' + ((octave-5)*12)
where
notenum :: Parser Integer
notenum = choice [char 'c' >> return 0,
char 'd' >> return 2,
char 'e' >> return 4,
char 'f' >> return 5,
char 'g' >> return 7,
char 'a' >> return 9,
char 'b' >> return 11
]
noteModifier :: Parser Integer
noteModifier = choice [char 's' >> return 1,
char 'f' >> return (-1),
char 'n' >> return 0
]
fromNote :: Integral c => Pattern String -> Pattern c
fromNote p = (\s -> either (const 0) id $ parse parseNote "" s) <$> p
pColour :: Parser (TPat ColourD)
pColour = do name <- many1 letter "colour name"
colour <- readColourName name "known colour"
return $ TPat_Atom colour
pMult :: Parseable a => TPat a -> Parser (TPat a)
pMult thing = do char '*'
spaces
r <- pRatio
return $ TPat_Density r thing
<|>
do char '/'
spaces
r <- pRatio
return $ TPat_Slow r thing
<|>
return thing
pRand :: Parseable a => TPat a -> Parser (TPat a)
pRand thing = do char '?'
spaces
return $ TPat_DegradeBy 0.5 thing
<|> return thing
pE :: Parseable a => TPat a -> Parser (TPat a)
pE thing = do (n,k,s) <- parens (pair)
pure $ TPat_pE n k s thing
<|> return thing
where pair :: Parser (TPat Int, TPat Int, TPat Integer)
pair = do a <- pSequence pIntegral
spaces
symbol ","
spaces
b <- pSequence pIntegral
c <- do symbol ","
spaces
pSequence pIntegral
<|> return (TPat_Atom 0)
return (a, b, c)
eoff :: Int -> Int -> Integer -> Pattern a -> Pattern a
eoff n k s p = ((s%(fromIntegral k)) `rotL`) (e n k p)
-- TPat_ShiftL (s%(fromIntegral k)) (TPat_E n k p)
pReplicate :: Parseable a => TPat a -> Parser [TPat a]
pReplicate thing =
do extras <- many $ do char '!'
-- if a number is given (without a space)slow 2 $ fast
-- replicate that number of times
n <- ((read <$> many1 digit) <|> return 2)
spaces
thing' <- pRand thing
-- -1 because we already have parsed the original one
return $ replicate (fromIntegral (n-1)) thing'
return (thing:concat extras)
pStretch :: Parseable a => TPat a -> Parser [TPat a]
pStretch thing =
do char '@'
n <- ((read <$> many1 digit) <|> return 1)
return $ map (\x -> TPat_Zoom (x%n,(x+1)%n) thing) [0 .. (n-1)]
pRatio :: Parser (Rational)
pRatio = do s <- sign
n <- natural
result <- do char '%'
d <- natural
return (n%d)
<|>
do char '.'
s <- many1 digit
-- A hack, but not sure if doing this
-- numerically would be any faster..
return (toRational $ ((read $ show n ++ "." ++ s) :: Double))
<|>
return (n%1)
return $ applySign s result
pRational :: Parser (TPat Rational)
pRational = do r <- pRatio
return $ TPat_Atom r
{-
pDensity :: Parser (Rational)
pDensity = angles (pRatio "ratio")
<|>
return (1 % 1)
-}
tidal-0.9.5/Sound/Tidal/SuperCollider.hs 0000644 0000000 0000000 00000001667 13212576414 016264 0 ustar 00 0000000 0000000 {-# LANGUAGE NoMonomorphismRestriction #-}
module Sound.Tidal.SuperCollider where
import Sound.Tidal.Stream
import Sound.Tidal.Pattern
import Sound.Tidal.Parse
import Sound.OSC.FD
import Sound.Tidal.OscStream
supercollider :: [Param] -> Double -> Shape
supercollider ps l = Shape {
params = ps,
cpsStamp = False,
latency = l
}
scSlang :: String -> OscSlang
scSlang n = OscSlang {
-- The OSC path
path = "/s_new",
preamble = [string n, int32 (-1), int32 1, int32 1],
namedParams = True,
timestamp = BundleStamp
}
scBackend :: String -> IO (Backend a)
scBackend n = do
s <- makeConnection "127.0.0.1" 57110 (scSlang n)
return $ Backend s (\_ _ _ -> return ())
scStream :: String -> [Param] -> Double -> IO (ParamPattern -> IO (), Shape)
scStream n ps l = do let shape = (supercollider ps l)
backend <- scBackend n
sc <- stream backend shape
return (sc, shape)
tidal-0.9.5/Sound/Tidal/Stream.hs 0000644 0000000 0000000 00000025333 13212576414 014737 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings, FlexibleInstances, RankNTypes, NoMonomorphismRestriction, DeriveDataTypeable #-}
module Sound.Tidal.Stream where
import Data.Maybe
import Control.Applicative
import Control.Concurrent
import Control.Concurrent.MVar
import Control.Exception as E
import Data.Time (getCurrentTime)
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
import Data.Ratio
import Data.Typeable
import Sound.Tidal.Pattern
import qualified Sound.Tidal.Parse as P
import Sound.Tidal.Tempo (Tempo, logicalTime, clocked,clockedTick,cps)
import Sound.Tidal.Utils
import qualified Sound.Tidal.Time as T
import qualified Data.Map.Strict as Map
type ToMessageFunc = Shape -> Tempo -> Int -> (Double, Double, ParamMap) -> Maybe (IO ())
data Backend a = Backend {
toMessage :: ToMessageFunc,
flush :: Shape -> Tempo -> Int -> IO ()
}
data Param = S {name :: String, sDefault :: Maybe String}
| F {name :: String, fDefault :: Maybe Double}
| I {name :: String, iDefault :: Maybe Int}
deriving Typeable
instance Eq Param where
a == b = name a == name b
instance Ord Param where
compare a b = compare (name a) (name b)
instance Show Param where
show p = name p
data Shape = Shape {params :: [Param],
latency :: Double,
cpsStamp :: Bool}
data Value = VS { svalue :: String } | VF { fvalue :: Double } | VI { ivalue :: Int }
deriving (Eq,Ord,Typeable)
instance Show Value where
show (VS s) = s
show (VF f) = show f
show (VI i) = show i
class ParamType a where
fromV :: Value -> Maybe a
toV :: a -> Value
instance ParamType String where
fromV (VS s) = Just s
fromV _ = Nothing
toV s = VS s
instance ParamType Double where
fromV (VF f) = Just f
fromV _ = Nothing
toV f = VF f
instance ParamType Int where
fromV (VI i) = Just i
fromV _ = Nothing
toV i = VI i
type ParamMap = Map.Map Param Value
type ParamPattern = Pattern ParamMap
ticksPerCycle = 8
defaultValue :: Param -> Value
defaultValue (S _ (Just x)) = VS x
defaultValue (I _ (Just x)) = VI x
defaultValue (F _ (Just x)) = VF x
hasDefault :: Param -> Bool
hasDefault (S _ Nothing) = False
hasDefault (I _ Nothing) = False
hasDefault (F _ Nothing) = False
hasDefault _ = True
defaulted :: Shape -> [Param]
defaulted = filter hasDefault . params
defaultMap :: Shape -> ParamMap
defaultMap s
= Map.fromList $ map (\x -> (x, defaultValue x)) (defaulted s)
required :: Shape -> [Param]
required = filter (not . hasDefault) . params
hasRequired :: Shape -> ParamMap -> Bool
hasRequired s m = isSubset (required s) (Map.keys m)
isSubset :: (Eq a) => [a] -> [a] -> Bool
isSubset xs ys = all (\x -> elem x ys) xs
doAt t action = do _ <- forkIO $ do
now <- getCurrentTime
let nowf = realToFrac $ utcTimeToPOSIXSeconds now
threadDelay $ floor $ (t - nowf) * 1000000
action
return ()
logicalOnset' change tick o offset = logicalNow + (logicalPeriod * o) + offset
where
tpc = fromIntegral ticksPerCycle
cycleD = ((fromIntegral tick) / tpc) :: Double
logicalNow = logicalTime change cycleD
logicalPeriod = (logicalTime change (cycleD + (1/tpc))) - logicalNow
applyShape' :: Shape -> ParamMap -> Maybe ParamMap
applyShape' s m | hasRequired s m = Just $ Map.union m (defaultMap s)
| otherwise = Nothing
start :: Backend a -> Shape -> IO (MVar (ParamPattern))
start backend shape
= do patternM <- newMVar silence
let ot = (onTick backend shape patternM) :: Tempo -> Int -> IO ()
forkIO $ clockedTick ticksPerCycle ot
return patternM
-- variant of start where history of patterns is available
state :: Backend a -> Shape -> IO (MVar (ParamPattern, [ParamPattern]))
state backend shape
= do patternsM <- newMVar (silence, [])
let ot = (onTick' backend shape patternsM) :: Tempo -> Int -> IO ()
forkIO $ clockedTick ticksPerCycle ot
return patternsM
stream :: Backend a -> Shape -> IO (ParamPattern -> IO ())
stream backend shape
= do patternM <- start backend shape
return $ \p -> do swapMVar patternM p
return ()
streamcallback :: (ParamPattern -> IO ()) -> Backend a -> Shape -> IO (ParamPattern -> IO ())
streamcallback callback backend shape
= do f <- stream backend shape
let f' p = do callback p
f p
return f'
onTick :: Backend a -> Shape -> MVar (ParamPattern) -> Tempo -> Int -> IO ()
onTick backend shape patternM change ticks
= do p <- readMVar patternM
let ticks' = (fromIntegral ticks) :: Integer
a = ticks' % ticksPerCycle
b = (ticks' + 1) % ticksPerCycle
messages = mapMaybe
(toMessage backend shape change ticks)
(seqToRelOnsetDeltas (a, b) p)
E.catch (sequence_ messages) (\msg -> putStrLn $ "oops " ++ show (msg :: E.SomeException))
flush backend shape change ticks
return ()
-- Variant where mutable variable contains list as history of the patterns
onTick' :: Backend a -> Shape -> MVar (ParamPattern, [ParamPattern]) -> Tempo -> Int -> IO ()
onTick' backend shape patternsM change ticks
= do ps <- readMVar patternsM
let ticks' = (fromIntegral ticks) :: Integer
toM = (toMessage backend)
a = ticks' % ticksPerCycle
b = (ticks' + 1) % ticksPerCycle
messages = mapMaybe
(toM shape change ticks)
(seqToRelOnsetDeltas (a, b) $ fst ps)
E.catch (sequence_ messages) (\msg -> putStrLn $ "oops " ++ show (msg :: E.SomeException))
flush backend shape change ticks
return ()
make :: (a -> Value) -> Shape -> String -> Pattern a -> ParamPattern
make toValue s nm p = fmap (\x -> Map.singleton nParam (defaultV x)) p
where nParam = param s nm
defaultV a = toValue a
--defaultV Nothing = defaultValue nParam
make' :: ParamType a => (a -> Value) -> Param -> Pattern a -> ParamPattern
make' toValue par p = fmap (\x -> Map.singleton par (toValue x)) p
makeP :: ParamType a => Param -> Pattern a -> ParamPattern
makeP par p = coerce par $ fmap (\x -> Map.singleton par (toV x)) p
makeS = make VS
makeF :: Shape -> String -> Pattern Double -> ParamPattern
makeF = make VF
makeI :: Shape -> String -> Pattern Int -> ParamPattern
makeI = make VI
param :: Shape -> String -> Param
param shape n = head $ filter (\x -> name x == n) (params shape)
merge :: ParamPattern -> ParamPattern -> ParamPattern
merge x y = (flip Map.union) <$> x <*> y
infixl 1 |=|
(|=|) :: ParamPattern -> ParamPattern -> ParamPattern
(|=|) = merge
infixl 1 #
(#) = (|=|)
mergeWith op x y = (Map.unionWithKey op) <$> x <*> y
mergeWith
:: (Ord k, Applicative f) =>
(k -> a -> a -> a)
-> f (Map.Map k a) -> f (Map.Map k a) -> f (Map.Map k a)
mergeNumWith intOp floatOp = mergeWith f
where f (F _ _) (VF a) (VF b) = VF $ floatOp a b
f (I _ _) (VI a) (VI b) = VI $ intOp a b
f _ _ b = b
mergePlus = mergeWith f
where f (F _ _) (VF a) (VF b) = VF $ a + b
f (I _ _) (VI a) (VI b) = VI $ a + b
f (S _ _) (VS a) (VS b) = VS $ a ++ b
f _ _ b = b
infixl 1 |*|
(|*|) :: ParamPattern -> ParamPattern -> ParamPattern
(|*|) = mergeNumWith (*) (*)
infixl 1 |+|
(|+|) :: ParamPattern -> ParamPattern -> ParamPattern
(|+|) = mergePlus
infixl 1 |-|
(|-|) :: ParamPattern -> ParamPattern -> ParamPattern
(|-|) = mergeNumWith (-) (-)
infixl 1 |/|
(|/|) :: ParamPattern -> ParamPattern -> ParamPattern
(|/|) = mergeNumWith (div) (/)
{- | These are shorthand for merging lists of patterns with @#@, @|*|@, @|+|@,
or @|/|@. Sometimes this saves a little typing and can improve readability
when passing things into other functions. As an example, instead of writing
@
d1 $ sometimes ((|*| speed "2") . (|*| cutoff "2") . (|*| shape "1.5")) $ sound "arpy*4" # cutoff "350" # shape "0.3"
@
you can write
@
d1 $ sometimes (*** [speed "2", cutoff "2", shape "1.5"]) $ sound "arpy*4" ### [cutoff "350", shape "0.3"]
@
-}
(###) = foldl (#)
(***) = foldl (|*|)
(+++) = foldl (|+|)
(///) = foldl (|/|)
setter :: MVar (a, [a]) -> a -> IO ()
setter ds p = do ps <- takeMVar ds
putMVar ds $ (p, p:snd ps)
return ()
{- | Copies values from one parameter to another. Used by @nToOrbit@ in @Sound.Tidal.Dirt@. -}
copyParam:: Param -> Param -> ParamPattern -> ParamPattern
copyParam fromParam toParam pat = f <$> pat
where f m = maybe m (updateValue m) (Map.lookup fromParam m)
updateValue m v = Map.union m (Map.fromList [(toParam,v)])
get :: ParamType a => Param -> ParamPattern -> Pattern a
get param p = filterJust $ fromV <$> (filterJust $ Map.lookup param <$> p)
getI :: Param -> ParamPattern -> Pattern Int
getI = get
getF :: Param -> ParamPattern -> Pattern Double
getF = get
getS :: Param -> ParamPattern -> Pattern String
getS = get
with :: (ParamType a) => Param -> (Pattern a -> Pattern a) -> ParamPattern -> ParamPattern
with param f p = p # (makeP param) ((\x -> f (get param x)) p)
withI :: Param -> (Pattern Int -> Pattern Int) -> ParamPattern -> ParamPattern
withI = with
withF :: Param -> (Pattern Double -> Pattern Double) -> ParamPattern -> ParamPattern
withF = with
withS :: Param -> (Pattern String -> Pattern String) -> ParamPattern -> ParamPattern
withS = with
follow :: (ParamType a, ParamType b) => Param -> Param -> (Pattern a -> Pattern b) -> ParamPattern -> ParamPattern
follow source dest f p = p # (makeP dest $ f (get source p))
-- follow :: ParamType a => Param -> (Pattern a -> ParamPattern) -> ParamPattern -> ParamPattern
-- follow source dest p = p # (dest $ get source p)
follow' :: ParamType a => Param -> Param -> (Pattern a -> Pattern a) -> ParamPattern -> ParamPattern
follow' source dest f p = p # (makeP dest $ f (get source p))
followI :: Param -> Param -> (Pattern Int -> Pattern Int) -> ParamPattern -> ParamPattern
followI = follow'
followF :: Param -> Param -> (Pattern Double -> Pattern Double) -> ParamPattern -> ParamPattern
followF = follow'
followS :: Param -> Param -> (Pattern String -> Pattern String) -> ParamPattern -> ParamPattern
followS = follow'
-- with :: ParamType a => Param -> (Pattern a -> Pattern a) -> ParamPattern -> ParamPattern
-- with source f p = p # (makeP source $ f (get source p))
coerce :: Param -> ParamPattern -> ParamPattern
coerce par@(S _ _) p = (Map.update f par) <$> p
where f (VS s) = Just (VS s)
f (VI i) = Just (VS $ show i)
f (VF f) = Just (VS $ show f)
coerce par@(I _ _) p = (Map.update f par) <$> p
where f (VS s) = Just (VI $ read s)
f (VI i) = Just (VI i)
f (VF f) = Just (VI $ floor f)
coerce par@(F _ _) p = (Map.update f par) <$> p
where f (VS s) = Just (VF $ read s)
f (VI i) = Just (VF $ fromIntegral i)
f (VF f) = Just (VF f)
tidal-0.9.5/Sound/Tidal/Transition.hs 0000644 0000000 0000000 00000011371 13212576414 015633 0 ustar 00 0000000 0000000 module Sound.Tidal.Transition where
import Sound.Tidal.Stream
import Sound.Tidal.Pattern
import Sound.Tidal.Time
import Sound.Tidal.Params
import Sound.Tidal.Utils
import Control.Concurrent.MVar
import Control.Applicative
import Data.Maybe
import qualified Data.Map.Strict as Map
import Data.Monoid
transition :: (IO Time) -> MVar (ParamPattern, [ParamPattern]) -> (Time -> [ParamPattern] -> ParamPattern) -> ParamPattern -> IO ()
transition getNow mv f p =
do now <- getNow
ps <- takeMVar mv
let p' = f now (p:snd ps)
-- don't put the transition in history, only
-- the target pattern, or things get overcomplex
-- (transitions of transitions)
putMVar mv (p', (p:snd ps))
return ()
-- | Pans the last n versions of the pattern across the field
histpan :: Int -> Time -> [ParamPattern] -> ParamPattern
histpan _ _ [] = silence
histpan 0 _ _ = silence
histpan n _ ps = stack $ map (\(i,p) -> p # pan (atom $ (fromIntegral i) / (fromIntegral n'))) (enumerate ps')
where ps' = take n ps
n' = length ps' -- in case there's fewer patterns than requested
{-|
A generalization of `wash`. Washes away the current pattern after a certain delay by applying a function to it over time, then switching over to the next pattern to which another function is applied.
-}
superwash :: (Pattern a -> Pattern a) -> (Pattern a -> Pattern a) -> Time -> Time -> Time -> Time -> [Pattern a] -> Pattern a
superwash _ _ _ _ _ _ [] = silence
superwash _ _ _ _ _ _ (p:[]) = p
superwash fout fin delay durin durout now (p:p':_) =
(playWhen (< (now + delay)) p') <>
(playWhen (between (now + delay) (now + delay + durin)) $ fout p') <>
(playWhen (between (now + delay + durin) (now + delay + durin + durout)) $ fin p) <>
(playWhen (>= (now + delay + durin + durout)) $ p)
where
between lo hi x = (x >= lo) && (x < hi)
{-|
Wash away the current pattern by applying a function to it over time, then switching over to the next.
@
d1 $ sound "feel ! feel:1 feel:2"
t1 (wash (chop 8) 4) $ sound "feel*4 [feel:2 sn:2]"
@
Note that `chop 8` is applied to `sound "feel ! feel:1 feel:2"` for 4 cycles and then the whole pattern is replaced by `sound "feel*4 [feel:2 sn:2]`
-}
wash :: (Pattern a -> Pattern a) -> Time -> Time -> [Pattern a] -> Pattern a
wash _ _ _ [] = silence
wash _ _ _ (p:[]) = p
wash f t now (p:p':_) = overlay (playWhen (< (now + t)) $ f p') (playWhen (>= (now + t)) p)
-- | Just stop for a bit before playing new pattern
wait :: Time -> Time -> [ParamPattern] -> ParamPattern
wait _ _ [] = silence
wait t now (p:_) = playWhen (>= (nextSam (now+t-1))) p
{- | Just as `wait`, `wait'` stops for a bit and then applies the given transition to the playing pattern
@
d1 $ sound "bd"
t1 (wait' (xfadeIn 8) 4) $ sound "hh*8"
@
-}
wait' :: (Time -> [ParamPattern] -> ParamPattern) -> Time -> Time -> [ParamPattern] -> ParamPattern
wait' _ t _ [] = silence
wait' f t now ps@(p:_) = playWhen (>= (nextSam (now+t-1))) (f (now + t) ps)
{- |
Jumps directly into the given pattern, this is essentially the _no transition_-transition.
Variants of `jump` provide more useful capabilities, see `jumpIn` and `jumpMod`
-}
jump :: Time -> [ParamPattern] -> ParamPattern
jump = jumpIn 0
{- | Sharp `jump` transition after the specified number of cycles have passed.
@
t1 (jumpIn 2) $ sound "kick(3,8)"
@
-}
jumpIn :: Int -> Time -> [ParamPattern] -> ParamPattern
jumpIn n = superwash id id (fromIntegral n) 0 0
{- | Unlike `jumpIn` the variant `jumpIn'` will only transition at cycle boundary (e.g. when the cycle count is an integer).
-}
jumpIn' :: Int -> Time -> [ParamPattern] -> ParamPattern
jumpIn' n now = superwash id id ((nextSam now) - now + (fromIntegral n)) 0 0 now
-- | Sharp `jump` transition at next cycle boundary where cycle mod n == 0
jumpMod :: Int -> Time -> [ParamPattern] -> ParamPattern
jumpMod n now = jumpIn ((n-1) - ((floor now) `mod` n)) now
-- | Degrade the new pattern over time until it ends in silence
mortal :: Time -> Time -> Time -> [ParamPattern] -> ParamPattern
mortal _ _ _ [] = silence
mortal lifespan release now (p:_) = overlay (playWhen (<(now+lifespan)) p) (playWhen (>= (now+lifespan)) (fadeOut' (now + lifespan) release p))
combineV :: (Value -> Value -> Value) -> ParamMap -> ParamMap -> ParamMap
combineV f a b = Map.mapWithKey pairUp a
where pairUp k v | Map.notMember k b = v
| otherwise = f v (fromJust $ Map.lookup k b)
mixNums v (VF a) (VF b) = VF $ (a * v) + (b * (1-v))
mixNums v (VI a) (VI b) = VI $ floor $ (fromIntegral a * v) + (fromIntegral b * (1-v))
mixNums v _ b = b
interpolateIn :: Time -> Time -> [ParamPattern] -> ParamPattern
interpolateIn _ _ [] = silence
interpolateIn _ _ (p:[]) = p
interpolateIn t now (p:p':_) = do n <- now `rotR` (_slow t envL)
combineV (mixNums n) <$> p <*> p'
tidal-0.9.5/Sound/Tidal/Time.hs 0000644 0000000 0000000 00000007660 13212576414 014405 0 ustar 00 0000000 0000000 {-|
Module: Time
Description: Defines core data types and functions for handling tidal's concept of time in `Arc`s & `Event`s
-}
module Sound.Tidal.Time where
import Sound.Tidal.Utils
import Data.Ratio
-- | Time is represented by a rational number. Each natural number
-- represents both the start of the next rhythmic cycle, and the end
-- of the previous one. Rational numbers are used so that subdivisions
-- of each cycle can be accurately represented.
type Time = Rational
-- | @(s,e) :: Arc@ represents a time interval with a start and end value.
-- @ { t : s <= t && t < e } @
type Arc = (Time, Time)
-- | An Event is a value that occurs during the period given by the
-- first @Arc@. The second one indicates the event's "domain of
-- influence". These will often be the same, but many temporal
-- transformations, such as rotation and scaling time, may result in
-- arcs being split or truncated. In such cases, the first arc is
-- preserved, but the second arc reflects the portion of the event
-- which is relevant.
type Event a = (Arc, Arc, a)
-- | The starting point of the current cycle. A cycle occurs from each
-- natural number to the next, so this is equivalent to @floor@.
sam :: Time -> Time
sam = fromIntegral . floor
-- | The end point of the current cycle (and starting point of the next cycle)
nextSam :: Time -> Time
nextSam = (1+) . sam
-- | The position of a time value relative to the start of its cycle.
cyclePos :: Time -> Time
cyclePos t = t - sam t
-- | @isIn a t@ is @True@ if @t@ is inside
-- the arc represented by @a@.
isIn :: Arc -> Time -> Bool
isIn (s,e) t = t >= s && t < e
-- | Splits the given @Arc@ into a list of @Arc@s, at cycle boundaries.
arcCycles :: Arc -> [Arc]
arcCycles (s,e) | s >= e = []
| sam s == sam e = [(s,e)]
| otherwise = (s, nextSam s) : (arcCycles (nextSam s, e))
-- | Splits the given @Arc@ into a list of @Arc@s, at cycle boundaries, but wrapping the arcs within the same cycle.
arcCycles' :: Arc -> [Arc]
arcCycles' (s,e) | s >= e = []
| sam s == sam e = [(s,e)]
| otherwise = (s, nextSam s) : (arcCycles' ((nextSam s) - 1, e - 1))
-- | @subArc i j@ is the arc that is the intersection of @i@ and @j@.
subArc :: Arc -> Arc -> Maybe Arc
subArc (s, e) (s',e') | s'' < e'' = Just (s'', e'')
| otherwise = Nothing
where s'' = max s s'
e'' = min e e'
-- | Map the given function over both the start and end @Time@ values
-- of the given @Arc@.
mapArc :: (Time -> Time) -> Arc -> Arc
mapArc f (s,e) = (f s, f e)
-- | Similar to @mapArc@ but time is relative to the cycle (i.e. the
-- sam of the start of the arc)
mapCycle :: (Time -> Time) -> Arc -> Arc
mapCycle f (s,e) = (sam' + (f $ s - sam'), sam' + (f $ e - sam'))
where sam' = sam s
-- | Returns the `mirror image' of an @Arc@ around the given point intime, used by @Sound.Tidal.Pattern.rev@.
mirrorArc :: Time -> Arc -> Arc
mirrorArc mid (s, e) = (mid - (e-mid), mid+(mid-s))
-- | The start time of the given @Event@
eventStart :: Event a -> Time
eventStart = fst . snd'
-- | The original onset of the given @Event@
eventOnset :: Event a -> Time
eventOnset = fst . fst'
-- | The original offset of the given @Event@
eventOffset :: Event a -> Time
eventOffset = snd . fst'
-- | The arc of the given @Event@
eventArc :: Event a -> Arc
eventArc = snd'
-- | The midpoint of an @Arc@
midPoint :: Arc -> Time
midPoint (s,e) = s + ((e - s) / 2)
-- | `True` if an `Event`'s first and second `Arc`'s start times match
hasOnset :: Event a -> Bool
hasOnset ((s,_), (s',_), _) = s == s'
-- | `True` if an `Event`'s first and second `Arc`'s end times match
hasOffset :: Event a -> Bool
hasOffset ((_,e), (_,e'), _) = e == e'
-- | `True` if an `Event`'s starts is within given `Arc`
onsetIn :: Arc -> Event a -> Bool
onsetIn a e = isIn a (eventOnset e)
-- | `True` if an `Event`'s ends is within given `Arc`
offsetIn :: Arc -> Event a -> Bool
offsetIn a e = isIn a (eventOffset e)
tidal-0.9.5/Sound/Tidal/Params.hs 0000644 0000000 0000000 00000037104 13212576414 014726 0 ustar 00 0000000 0000000 module Sound.Tidal.Params where
import Sound.Tidal.Stream
import Sound.Tidal.Pattern
import qualified Data.Map as Map
import Sound.Tidal.Utils
import Control.Applicative
-- | group multiple params into one
grp :: [Param] -> Pattern String -> ParamPattern
grp [] _ = silence
grp params p = (fmap lookupPattern p)
where lookupPattern :: String -> ParamMap
lookupPattern s = Map.fromList $ map (\(param,s') -> toPV param s') $ zip params $ (split s)
split s = wordsBy (==':') s
toPV :: Param -> String -> (Param, Value)
toPV param@(S _ _) s = (param, (VS s))
toPV param@(F _ _) s = (param, (VF $ read s))
toPV param@(I _ _) s = (param, (VI $ read s))
{- |
A pattern of strings representing sounds or synth notes.
Internally, `sound` or its shorter alias `s` is a combination of the samplebank name and number when used with samples, or synth name and note number when used with a synthesiser. For example `bd:2` specifies the third sample (not the second as you might expect, because we start counting at zero) in the `bd` sample folder.
*Internally, `sound`/`s` is a combination of two parameters, the
hidden parameter `s'` which specifies the samplebank or synth, and the
`n` parameter which specifies the sample or note number. For example:
@
d1 $ sound "bd:2 sn:0"
@
is essentially the same as:
@
d1 $ s' "bd sn" # n "2 0"
@
`n` is therefore useful when you want to pattern the sample or note
number separately from the samplebank or synth. For example:
@
d1 $ n "0 5 ~ 2" # sound "drum"
@
is equivalent to:
@
d1 $ sound "drum:0 drum:5 ~ drum:2"
@
-}
sound :: Pattern String -> ParamPattern
sound = grp [s_p, n_p]
s = sound
pF name defaultV = (make' VF param, param)
where param = F name defaultV
pI name defaultV = (make' VI param, param)
where param = I name defaultV
pS name defaultV = (make' VS param, param)
where param = S name defaultV
-- | a pattern of numbers that speed up (or slow down) samples while they play.
(accelerate, accelerate_p) = pF "accelerate" (Just 0)
-- | a pattern of numbers to specify the attack time (in seconds) of an envelope applied to each sample. Only takes effect if `release` is also specified.
(attack, attack_p) = pF "attack" (Just (-1))
-- | a pattern of numbers from 0 to 1. Sets the center frequency of the band-pass filter.
(bandf, bandf_p) = pF "bandf" (Just 0)
-- | a pattern of numbers from 0 to 1. Sets the q-factor of the band-pass filter.
(bandq, bandq_p) = pF "bandq" (Just 0)
{- | a pattern of numbers from 0 to 1. Skips the beginning of each sample, e.g. `0.25` to cut off the first quarter from each sample.
Using `begin "-1"` combined with `cut "-1"` means that when the sample cuts itself it will begin playback from where the previous one left off, so it will sound like one seamless sample. This allows you to apply a synth param across a long sample in a way similar to `chop`:
@
cps 0.5
d1 $ sound "breaks125*8" # unit "c" # begin "-1" # cut "-1" # coarse "1 2 4 8 16 32 64 128"
@
This will play the `breaks125` sample and apply the changing `coarse` parameter over the sample. Compare to:
@
d1 $ (chop 8 $ sounds "breaks125") # unit "c" # coarse "1 2 4 8 16 32 64 128"
@
which performs a similar effect, but due to differences in implementation sounds different.
-}
begin_p, channel_p, legato_p, clhatdecay_p, coarse_p, crush_p :: Param
begin, legato, clhatdecay, crush :: Pattern Double -> ParamPattern
channel, coarse :: Pattern Int -> ParamPattern
(begin, begin_p) = pF "begin" (Just 0)
-- | choose the physical channel the pattern is sent to, this is super dirt specific
(channel, channel_p) = pI "channel" Nothing
--legato controls the amount of overlap between two adjacent synth sounds
(legato, legato_p) = pF "legato" (Just 1)
(clhatdecay, clhatdecay_p) = pF "clhatdecay" (Just 0)
-- | fake-resampling, a pattern of numbers for lowering the sample rate, i.e. 1 for original 2 for half, 3 for a third and so on.
(coarse, coarse_p) = pI "coarse" (Just 0)
-- | bit crushing, a pattern of numbers from 1 (for drastic reduction in bit-depth) to 16 (for barely no reduction).
(crush, crush_p) = pF "crush" (Just 0)
{- |
In the style of classic drum-machines, `cut` will stop a playing sample as soon as another samples with in same cutgroup is to be played.
An example would be an open hi-hat followed by a closed one, essentially muting the open.
@
d1 $ stack [
sound "bd",
sound "~ [~ [ho:2 hc/2]]" # cut "1"
]
@
This will mute the open hi-hat every second cycle when the closed one is played.
Using `cut` with negative values will only cut the same sample. This is useful to cut very long samples
@
d1 $ sound "[bev, [ho:3](3,8)]" # cut "-1"
@
Using `cut "0"` is effectively _no_ cutgroup.
-}
(cut, cut_p) = pI "cut" (Just 0)
-- | a pattern of numbers from 0 to 1. Applies the cutoff frequency of the low-pass filter.
(cutoff, cutoff_p) = pF "cutoff" (Just 0)
(cutoffegint, cutoffegint_p) = pF "cutoffegint" (Just 0)
(decay, decay_p) = pF "decay" (Just 0)
-- | a pattern of numbers from 0 to 1. Sets the level of the delay signal.
(delay, delay_p) = pF "delay" (Just 0)
-- | a pattern of numbers from 0 to 1. Sets the amount of delay feedback.
(delayfeedback, delayfeedback_p) = pF "delayfeedback" (Just (-1))
-- | a pattern of numbers from 0 to 1. Sets the length of the delay.
(delaytime, delaytime_p) = pF "delaytime" (Just (-1))
(detune, detune_p) = pF "detune" (Just 0)
-- | when set to `1` will disable all reverb for this pattern. See `room` and `size` for more information about reverb.
(dry, dry_p) = pF "dry" (Just 0)
{- the same as `begin`, but cuts the end off samples, shortening them;
e.g. `0.75` to cut off the last quarter of each sample.
-}
(end, end_p) = pF "end" (Just 1)
-- | a pattern of numbers that specify volume. Values less than 1 make the sound quieter. Values greater than 1 make the sound louder.
(gain, gain_p) = pF "gain" (Just 1)
(gate, gate_p) = pF "gate" (Just 0)
(hatgrain, hatgrain_p) = pF "hatgrain" (Just 0)
-- | a pattern of numbers from 0 to 1. Applies the cutoff frequency of the high-pass filter.
(hcutoff, hcutoff_p) = pF "hcutoff" (Just 0)
-- | a pattern of numbers to specify the hold time (in seconds) of an envelope applied to each sample. Only takes effect if `attack` and `release` are also specified.
(hold, hold_p) = pF "hold" (Just 0)
-- | a pattern of numbers from 0 to 1. Applies the resonance of the high-pass filter.
(hresonance, hresonance_p) = pF "hresonance" (Just 0)
(kriole, kriole_p) = pI "kriole" (Just 0)
(lagogo, lagogo_p) = pF "lagogo" (Just 0)
(lclap, lclap_p) = pF "lclap" (Just 0)
(lclaves, lclaves_p) = pF "lclaves" (Just 0)
(lclhat, lclhat_p) = pF "lclhat" (Just 0)
(lcrash, lcrash_p) = pF "lcrash" (Just 0)
(lfo, lfo_p) = pF "lfo" (Just 0)
(lfocutoffint, lfocutoffint_p) = pF "lfocutoffint" (Just 0)
(lfodelay, lfodelay_p) = pF "lfodelay" (Just 0)
(lfoint, lfoint_p) = pF "lfoint" (Just 0)
(lfopitchint, lfopitchint_p) = pF "lfopitchint" (Just 0)
(lfoshape, lfoshape_p) = pF "lfoshape" (Just 0)
(lfosync, lfosync_p) = pF "lfosync" (Just 0)
(lhitom, lhitom_p) = pF "lhitom" (Just 0)
(lkick, lkick_p) = pF "lkick" (Just 0)
(llotom, llotom_p) = pF "llotom" (Just 0)
{- | A pattern of numbers. Specifies whether delaytime is calculated relative to cps. When set to 1, delaytime is a direct multiple of a cycle.
-}
(lock, lock_p) = pF "lock" (Just 0)
-- | loops the sample (from `begin` to `end`) the specified number of times.
(loop, loop_p) = pF "loop" (Just 1)
(lophat, lophat_p) = pF "lophat" (Just 0)
(lsnare, lsnare_p) = pF "lsnare" (Just 0)
-- | specifies the sample variation to be used
(n, n_p) = pI "n" (Just 0)
{- |
Pushes things forward (or backwards within built-in latency) in time. Allows for nice things like _swing_ feeling:
@
d1 $ stack [
sound "bd bd/4",
sound "hh(5,8)"
] # nudge "[0 0.04]*4"
@
--pitch model -}
degree, mtranspose, ctranspose, harmonic, stepsPerOctave, octaveRatio :: Pattern Double -> ParamPattern
degree_p, mtranspose_p, ctranspose_p, harmonic_p, stepsPerOctave_p, octaveRatio_p :: Param
(degree, degree_p) = pF "degree" Nothing
(mtranspose, mtranspose_p) = pF "mtranspose" Nothing
(ctranspose, ctranspose_p) = pF "ctranspose" Nothing
(harmonic, harmonic_p) = pF "ctranspose" Nothing
(stepsPerOctave, stepsPerOctave_p) = pF "stepsPerOctave" Nothing
(octaveRatio, octaveRatio_p) = pF "octaveRatio" Nothing
--Low values will give a more _human_ feeling, high values might result in quite the contrary.
(nudge, nudge_p) = pF "nudge" (Just 0)
(octave, octave_p) = pI "octave" (Just 3)
(offset, offset_p) = pF "offset" (Just 0)
(ophatdecay, ophatdecay_p) = pF "ophatdecay" (Just 0)
{- | a pattern of numbers. An `orbit` is a global parameter context for patterns. Patterns with the same orbit will share hardware output bus offset and global effects, e.g. reverb and delay. The maximum number of orbits is specified in the superdirt startup, numbers higher than maximum will wrap around.
-}
(orbit, orbit_p) = pI "orbit" (Just 0)
-- | a pattern of numbers between 0 and 1, from left to right (assuming stereo), once round a circle (assuming multichannel)
(pan, pan_p) = pF "pan" (Just 0.5)
-- | a pattern of numbers between -inf and inf, which controls how much multichannel output is fanned out (negative is backwards ordering)
(panspan, panspan_p) = pF "span" (Just 1.0)
-- | a pattern of numbers between 0.0 and 1.0, which controls the multichannel spread range (multichannel only)
(pansplay, pansplay_p) = pF "splay" (Just 1.0)
-- | a pattern of numbers between 0.0 and inf, which controls how much each channel is distributed over neighbours (multichannel only)
(panwidth, panwidth_p) = pF "panwidth" (Just 2.0)
-- | a pattern of numbers between -1.0 and 1.0, which controls the relative position of the centre pan in a pair of adjacent speakers (multichannel only)
(panorient, panorient_p) = pF "orientation" (Just 0.5)
(pitch1, pitch1_p) = pF "pitch1" (Just 0)
(pitch2, pitch2_p) = pF "pitch2" (Just 0)
(pitch3, pitch3_p) = pF "pitch3" (Just 0)
(portamento, portamento_p) = pF "portamento" (Just 0)
-- | a pattern of numbers to specify the release time (in seconds) of an envelope applied to each sample. Only takes effect if `attack` is also specified.
(release, release_p) = pF "release" (Just (-1))
-- | a pattern of numbers from 0 to 1. Specifies the resonance of the low-pass filter.
(resonance, resonance_p) = pF "resonance" (Just 0)
-- | a pattern of numbers from 0 to 1. Sets the level of reverb.
(room, room_p) = pF "room" Nothing
(sagogo, sagogo_p) = pF "sagogo" (Just 0)
(sclap, sclap_p) = pF "sclap" (Just 0)
(sclaves, sclaves_p) = pF "sclaves" (Just 0)
(scrash, scrash_p) = pF "scrash" (Just 0)
(semitone, semitone_p) = pF "semitone" (Just 0)
-- | wave shaping distortion, a pattern of numbers from 0 for no distortion up to 1 for loads of distortion.
(shape, shape_p) = pF "shape" (Just 0)
-- | a pattern of numbers from 0 to 1. Sets the perceptual size (reverb time) of the `room` to be used in reverb.
(size, size_p) = pF "size" Nothing
(slide, slide_p) = pF "slide" (Just 0)
-- | a pattern of numbers which changes the speed of sample playback, i.e. a cheap way of changing pitch. Negative values will play the sample backwards!
(speed, speed_p) = pF "speed" (Just 1)
-- | a pattern of strings. Selects the sample to be played.
(s', s_p) = pS "s" Nothing
(stutterdepth, stutterdepth_p) = pF "stutterdepth" (Just 0)
(stuttertime, stuttertime_p) = pF "stuttertime" (Just 0)
(sustain, sustain_p) = pF "sustain" (Just 0)
(tomdecay, tomdecay_p) = pF "tomdecay" (Just 0)
{- | used in conjunction with `speed`, accepts values of "r" (rate, default behavior), "c" (cycles), or "s" (seconds).
Using `unit "c"` means `speed` will be interpreted in units of cycles, e.g. `speed "1"` means samples will be stretched to fill a cycle.
Using `unit "s"` means the playback speed will be adjusted so that the duration is the number of seconds specified by `speed`.
-}
(unit, unit_p) = pS "unit" (Just "rate")
(velocity, velocity_p) = pF "velocity" (Just 0.5)
(vcfegint, vcfegint_p) = pF "vcfegint" (Just 0)
(vcoegint, vcoegint_p) = pF "vcoegint" (Just 0)
(voice, voice_p) = pF "voice" (Just 0)
-- | formant filter to make things sound like vowels, a pattern of either `a`, `e`, `i`, `o` or `u`. Use a rest (`~`) for no effect.
(vowel, vowel_p) = pS "vowel" (Just "")
-- MIDI-specific params
(dur,dur_p) = pF "dur" (Just 0.05)
(modwheel,modwheel_p) = pF "modwheel" (Just 0)
(expression,expression_p) = pF "expression" (Just 1)
(sustainpedal,sustainpedal_p) = pF "sustainpedal" (Just 0)
-- Tremolo Audio DSP effect | params are "tremolorate" and "tremolodepth"
tremolorate, tremolodepth :: Pattern Double -> ParamPattern
tremolorate_p, tremolodepth_p :: Param
(tremolorate,tremolorate_p) = pF "tremolorate" (Just 1)
(tremolodepth,tremolodepth_p) = pF "tremolodepth" (Just 0.5)
-- Phaser Audio DSP effect | params are "phaserrate" and "phaserdepth"
phaserrate, phaserdepth :: Pattern Double -> ParamPattern
phaserrate_p, phaserdepth_p :: Param
(phaserrate,phaserrate_p) = pF "phaserrate" (Just 1)
(phaserdepth,phaserdepth_p) = pF "phaserdepth" (Just 0.5)
-- aliases
att, chdecay, ctf, ctfg, delayfb, delayt, lbd, lch, lcl, lcp, lcr, lfoc, lfoi
, lfop, lht, llt, loh, lsn, ohdecay, phasdp, phasr, pit1, pit2, pit3, por, sag, scl, scp
, scr, sld, std, stt, sus, tdecay, tremdp, tremr, vcf, vco, voi
:: Pattern Double -> ParamPattern
att = attack
bpf = bandf
bpf_p = bandf_p
bpq = bandq
bpq_p = bandq_p
chdecay = clhatdecay
ctf = cutoff
ctfg = cutoffegint
delayfb = delayfeedback
delayt = delaytime
det = detune
gat = gate
hg = hatgrain
hpf = hcutoff
hpf_p = hcutoff_p
hpq = hresonance
hpq_p = hresonance_p
lag = lagogo
lbd = lkick
lch = lclhat
lcl = lclaves
lcp = lclap
lcr = lcrash
lfoc = lfocutoffint
lfoi = lfoint
lfop = lfopitchint
lht = lhitom
llt = llotom
loh = lophat
lpf = cutoff
lpf_p = cutoff_p
lpq = resonance
lpq_p = resonance_p
lsn = lsnare
ohdecay = ophatdecay
phasdp = phaserdepth
phasr = phaserrate
pit1 = pitch1
pit2 = pitch2
pit3 = pitch3
por = portamento
rel = release
sag = sagogo
scl = sclaves
scp = sclap
scr = scrash
sz = size
sld = slide
std = stutterdepth
stt = stuttertime
sus = sustain
tdecay = tomdecay
tremdp = tremolodepth
tremr = tremolorate
vcf = vcfegint
vco = vcoegint
voi = voice
note, midinote :: Pattern Int -> ParamPattern
note = n
midinote = n . ((subtract 60) <$>)
drum :: Pattern String -> ParamPattern
drum = midinote . (drumN <$>)
drumN :: String -> Int
drumN "bd" = 36
drumN "sn" = 38
drumN "lt" = 43
drumN "ht" = 50
drumN "ch" = 42
drumN "oh" = 46
drumN "cp" = 39
drumN "cl" = 75
drumN "ag" = 67
drumN "cr" = 49
drumN _ = 0
tidal-0.9.5/Sound/Tidal/Dirt.hs 0000644 0000000 0000000 00000033036 13212576414 014405 0 ustar 00 0000000 0000000 {-# LANGUAGE NoMonomorphismRestriction #-}
module Sound.Tidal.Dirt where
import Sound.OSC.FD (Datum)
import qualified Data.Map as Map
import Control.Applicative
import Control.Concurrent.MVar
--import Visual
import Data.Colour.SRGB
import Data.Colour.Names
import Data.Hashable
import Data.Bits
import Data.Maybe
import Data.Fixed
import Data.Ratio
import Data.List (elemIndex, sort)
import Sound.Tidal.Stream
import Sound.Tidal.OscStream
import Sound.Tidal.Pattern
import Sound.Tidal.Parse
import Sound.Tidal.Params
import Sound.Tidal.Time
import Sound.Tidal.Tempo
import Sound.Tidal.Transition (transition, wash)
import Sound.Tidal.Utils (enumerate, fst')
dirt :: Shape
dirt = Shape { params = [ s_p,
offset_p,
begin_p,
end_p,
speed_p,
pan_p,
velocity_p,
vowel_p,
cutoff_p,
resonance_p,
accelerate_p,
shape_p,
kriole_p,
gain_p,
cut_p,
delay_p,
delaytime_p,
delayfeedback_p,
crush_p,
coarse_p,
hcutoff_p,
hresonance_p,
bandf_p,
bandq_p,
unit_p,
loop_p,
n_p,
attack_p,
hold_p,
release_p
],
cpsStamp = True,
latency = 0.3
}
dirtSlang = OscSlang {
path = "/play",
timestamp = MessageStamp,
namedParams = False,
preamble = []
}
superDirtSlang = dirtSlang { timestamp = BundleStamp, path = "/play2", namedParams = True }
superDirtBackend port = do
s <- makeConnection "127.0.0.1" port superDirtSlang
return $ Backend s (\_ _ _ -> return ())
superDirtState port = do
backend <- superDirtBackend port
Sound.Tidal.Stream.state backend dirt
dirtBackend = do
s <- makeConnection "127.0.0.1" 7771 dirtSlang
return $ Backend s (\_ _ _ -> return ())
-- dirtstart name = start "127.0.0.1" 7771 dirt
dirtStream = do
backend <- dirtBackend
stream backend dirt
dirtState = do
backend <- dirtBackend
Sound.Tidal.Stream.state backend dirt
dirtSetters :: IO Time -> IO (ParamPattern -> IO (), (Time -> [ParamPattern] -> ParamPattern) -> ParamPattern -> IO ())
dirtSetters getNow = do ds <- dirtState
return (setter ds, transition getNow ds)
superDirtSetters :: IO Time -> IO (ParamPattern -> IO (), (Time -> [ParamPattern] -> ParamPattern) -> ParamPattern -> IO ())
superDirtSetters getNow = do ds <- superDirtState 57120
return (setter ds, transition getNow ds)
superDirts :: [Int] -> IO [(ParamPattern -> IO (), (Time -> [ParamPattern] -> ParamPattern) -> ParamPattern -> IO ())]
superDirts ports = do (_, getNow) <- cpsUtils
states <- mapM (superDirtState) ports
return $ map (\state -> (setter state, transition getNow state)) states
-- -- disused parameter..
dirtstream _ = dirtStream
-- doubledirt = do remote <- stream "178.77.72.138" 7777 dirt
-- local <- stream "192.168.0.102" 7771 dirt
-- return $ \p -> do remote p
-- local p
-- return ()
dirtToColour :: ParamPattern -> Pattern ColourD
--dirtToColour p = s
-- where s = fmap (\x -> maybe black (datumToColour) (Map.lookup (param dirt "s") x)) p
dirtToColour = fmap (stringToColour . show)
showToColour :: Show a => a -> ColourD
showToColour = stringToColour . show
datumToColour :: Value -> ColourD
datumToColour = showToColour
stringToColour :: String -> ColourD
stringToColour s = sRGB (r/256) (g/256) (b/256)
where i = (hash s) `mod` 16777216
r = fromIntegral $ (i .&. 0xFF0000) `shiftR` 16;
g = fromIntegral $ (i .&. 0x00FF00) `shiftR` 8;
b = fromIntegral $ (i .&. 0x0000FF);
{-
visualcallback :: IO (ParamPattern -> IO ())
visualcallback = do t <- ticker
mv <- startVis t
let f p = do let p' = dirtToColour p
swapMVar mv p'
return ()
return f
-}
--dirtyvisualstream name = do cb <- visualcallback
-- streamcallback cb "127.0.0.1" "127.0.0.1" name "127.0.0.1" 7771 dirt
pick :: String -> Int -> String
pick name n = name ++ ":" ++ (show n)
{- | Striate is a kind of granulator, for example:
@
d1 $ striate 3 $ sound "ho ho:2 ho:3 hc"
@
This plays the loop the given number of times, but triggering
progressive portions of each sample. So in this case it plays the loop
three times, the first time playing the first third of each sample,
then the second time playing the second third of each sample, etc..
With the highhat samples in the above example it sounds a bit like
reverb, but it isn't really.
You can also use striate with very long samples, to cut it into short
chunks and pattern those chunks. This is where things get towards
granular synthesis. The following cuts a sample into 128 parts, plays
it over 8 cycles and manipulates those parts by reversing and rotating
the loops.
@
d1 $ slow 8 $ striate 128 $ sound "bev"
@
-}
striate :: Pattern Int -> ParamPattern -> ParamPattern
striate = temporalParam _striate
_striate :: Int -> ParamPattern -> ParamPattern
_striate n p = fastcat $ map (\x -> off (fromIntegral x) p) [0 .. n-1]
where off i p = p
# begin (atom (fromIntegral i / fromIntegral n))
# end (atom (fromIntegral (i+1) / fromIntegral n))
{-|
The `striate'` function is a variant of `striate` with an extra
parameter, which specifies the length of each part. The `striate'`
function still scans across the sample over a single cycle, but if
each bit is longer, it creates a sort of stuttering effect. For
example the following will cut the bev sample into 32 parts, but each
will be 1/16th of a sample long:
@
d1 $ slow 32 $ striate' 32 (1/16) $ sound "bev"
@
Note that `striate` uses the `begin` and `end` parameters
internally. This means that if you're using `striate` (or `striate'`)
you probably shouldn't also specify `begin` or `end`. -}
striate' :: Pattern Int -> Pattern Double -> ParamPattern -> ParamPattern
striate' = temporalParam2 _striate'
_striate' :: Int -> Double -> ParamPattern -> ParamPattern
_striate' n f p = fastcat $ map (\x -> off (fromIntegral x) p) [0 .. n-1]
where off i p = p # begin (atom (slot * i) :: Pattern Double) # end (atom ((slot * i) + f) :: Pattern Double)
slot = (1 - f) / (fromIntegral n)
{- | like `striate`, but with an offset to the begin and end values -}
striateO :: Pattern Int -> Pattern Double -> ParamPattern -> ParamPattern
striateO = temporalParam2 _striateO
_striateO :: Int -> Double -> ParamPattern -> ParamPattern
_striateO n o p = _striate n p |+| begin (atom o :: Pattern Double) |+| end (atom o :: Pattern Double)
{- | Just like `striate`, but also loops each sample chunk a number of times specified in the second argument.
The primed version is just like `striate'`, where the loop count is the third argument. For example:
@
d1 $ striateL' 3 0.125 4 $ sound "feel sn:2"
@
Like `striate`, these use the `begin` and `end` parameters internally, as well as the `loop` parameter for these versions.
-}
striateL :: Pattern Int -> Pattern Int -> ParamPattern -> ParamPattern
striateL = temporalParam2 _striateL
striateL' :: Pattern Int -> Pattern Double -> Pattern Int -> ParamPattern -> ParamPattern
striateL' = temporalParam3 _striateL'
_striateL :: Int -> Int -> ParamPattern -> ParamPattern
_striateL n l p = _striate n p # loop (atom $ fromIntegral l)
_striateL' n f l p = _striate' n f p # loop (atom $ fromIntegral l)
metronome = _slow 2 $ sound (p "[odx, [hh]*8]")
{-|
Also degrades the current pattern and undegrades the next.
To change the number of cycles the transition takes, you can use @clutchIn@ like so:
@
d1 $ sound "bd(5,8)"
t1 (clutchIn 8) $ sound "[hh*4, odx(3,8)]"
@
will take 8 cycles for the transition.
-}
clutchIn :: Time -> Time -> [Pattern a] -> Pattern a
clutchIn _ _ [] = silence
clutchIn _ _ (p:[]) = p
clutchIn t now (p:p':_) = overlay (fadeOut' now t p') (fadeIn' now t p)
{-|
Degrades the current pattern while undegrading the next.
This is like @xfade@ but not by gain of samples but by randomly removing events from the current pattern and slowly adding back in missing events from the next one.
@
d1 $ sound "bd(3,8)"
t1 clutch $ sound "[hh*4, odx(3,8)]"
@
@clutch@ takes two cycles for the transition, essentially this is @clutchIn 2@.
-}
clutch :: Time -> [Pattern a] -> Pattern a
clutch = clutchIn 2
{- | crossfades between old and new pattern over given number of cycles, e.g.:
@
d1 $ sound "bd sn"
t1 (xfadeIn 16) $ sound "jvbass*3"
@
Will fade over 16 cycles from "bd sn" to "jvbass*3"
-}
xfadeIn :: Time -> Time -> [ParamPattern] -> ParamPattern
xfadeIn _ _ [] = silence
xfadeIn _ _ (p:[]) = p
xfadeIn t now (p:p':_) = overlay (p |*| gain (now `rotR` (_slow t envEqR))) (p' |*| gain (now `rotR` (_slow t (envEq))))
{- |
Crossfade between old and new pattern over the next two cycles.
@
d1 $ sound "bd sn"
t1 xfade $ sound "can*3"
@
`xfade` is built with `xfadeIn` in this case taking two cycles for the fade.
-}
xfade :: Time -> [ParamPattern] -> ParamPattern
xfade = xfadeIn 2
{- | Stut applies a type of delay to a pattern. It has three parameters,
which could be called depth, feedback and time. Depth is an integer
and the others floating point. This adds a bit of echo:
@
d1 $ stut 4 0.5 0.2 $ sound "bd sn"
@
The above results in 4 echos, each one 50% quieter than the last,
with 1/5th of a cycle between them. It is possible to reverse the echo:
@
d1 $ stut 4 0.5 (-0.2) $ sound "bd sn"
@
-}
stut :: Pattern Integer -> Pattern Double -> Pattern Rational -> ParamPattern -> ParamPattern
stut = temporalParam3 _stut
_stut :: Integer -> Double -> Rational -> ParamPattern -> ParamPattern
_stut steps feedback time p = stack (p:(map (\x -> (((x%steps)*time) `rotR` (p |*| gain (pure $ scale (fromIntegral x))))) [1..(steps-1)]))
where scale x
= ((+feedback) . (*(1-feedback)) . (/(fromIntegral steps)) . ((fromIntegral steps)-)) x
{- | Instead of just decreasing volume to produce echoes, @stut'@ allows to apply a function for each step and overlays the result delayed by the given time.
@
d1 $ stut' 2 (1%3) (# vowel "{a e i o u}%2") $ sound "bd sn"
@
In this case there are two _overlays_ delayed by 1/3 of a cycle, where each has the @vowel@ filter applied.
-}
stut' :: Pattern Int -> Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
stut' n t f p = unwrap $ (\a b -> _stut' a b f p) <$> n <*> t
_stut' :: (Num n, Ord n) => n -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_stut' steps steptime f p | steps <= 0 = p
| otherwise = overlay (f (steptime `rotR` _stut' (steps-1) steptime f p)) p
{- | @durPattern@ takes a pattern and returns the length of events in that
pattern as a new pattern. For example the result of `durPattern "[a ~] b"`
would be `"[0.25 ~] 0.5"`.
-}
durPattern :: Pattern a -> Pattern Time
durPattern p = Pattern $ \a -> map eventLengthEvent $ arc p a
where eventLengthEvent (a1@(s1,e1), a2, x) = (a1, a2, e1-s1)
{- | @durPattern'@ is similar to @durPattern@, but does some lookahead to try
to find the length of time to the *next* event. For example, the result of
`durPattern' "[a ~] b"` would be `"[0.5 ~] 0.5"`.
-}
durPattern' :: Pattern a -> Pattern Time
durPattern' p = Pattern $ \a@(s,e) -> map (eventDurToNext (arc p (s,e+1))) (arc p a)
where eventDurToNext evs ev@(a1,a2,x) = (a1, a2, (nextNum (t ev) (mt evs)) - (t ev))
t = fst . fst'
mt = (map fst) . (map fst')
nextNum a = head . sort . filter (\x -> x >a)
{- | @stutx@ is like @stut'@ but will limit the number of repeats using the
duration of the original sound. This usually prevents overlapping "stutters"
from subsequent sounds.
-}
stutx :: Pattern Int -> Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
stutx n t f p = stut' (liftA2 min n (fmap floor $ durPattern' p / (t+0.001))) t f p
{-| same as `anticipate` though it allows you to specify the number of cycles until dropping to the new pattern, e.g.:
@
d1 $ sound "jvbass(3,8)"
t1 (anticipateIn 4) $ sound "jvbass(5,8)"
@-}
anticipateIn :: Time -> Time -> [ParamPattern] -> ParamPattern
anticipateIn t now = wash (spread' (_stut 8 0.2) (now `rotR` (_slow t $ (toRational . (1-)) <$> envL))) t now
{- | `anticipate` is an increasing comb filter.
Build up some tension, culminating in a _drop_ to the new pattern after 8 cycles.
-}
anticipate :: Time -> [ParamPattern] -> ParamPattern
anticipate = anticipateIn 8
{- | Copies the @n@ parameter to the @orbit@ parameter, so different sound variants or notes go to different orbits in SuperDirt. -}
nToOrbit = copyParam n_p orbit_p
{- | Maps the sample or synth names to different @orbit@s, using indexes from the given list. E.g. @soundToOrbit ["bd", "sn", "cp"] $ sound "bd [cp sn]"@ would cause the bd, sn and cp smamples to be sent to orbit 0, 1, 2 respectively.-}
soundToOrbit :: [String] -> ParamPattern -> ParamPattern
soundToOrbit sounds p = follow s_p orbit_p ((\s -> fromMaybe 0 $ elemIndex s sounds) <$>) p
tidal-0.9.5/Sound/Tidal/Chords.hs 0000644 0000000 0000000 00000005243 13212576414 014724 0 ustar 00 0000000 0000000 module Sound.Tidal.Chords where
import Sound.Tidal.Pattern
import Data.Maybe
import Control.Applicative
major :: Num a => [a]
major = [0,4,7]
minor :: Num a => [a]
minor = [0,3,7]
major7 :: Num a => [a]
major7 = [0,4,7,11]
dom7 :: Num a => [a]
dom7 = [0,4,7,10]
minor7 :: Num a => [a]
minor7 = [0,3,7,10]
aug :: Num a => [a]
aug = [0,4,8]
dim :: Num a => [a]
dim = [0,3,6]
dim7 :: Num a => [a]
dim7 = [0,3,6,9]
one :: Num a => [a]
one = [0]
five :: Num a => [a]
five = [0,7]
plus :: Num a => [a]
plus = [0,4,8]
sharp5 :: Num a => [a]
sharp5 = [0,4,8]
msharp5 :: Num a => [a]
msharp5 = [0,3,8]
sus2 :: Num a => [a]
sus2 = [0,2,7]
sus4 :: Num a => [a]
sus4 = [0,5,7]
six :: Num a => [a]
six = [0,4,7,9]
m6 :: Num a => [a]
m6 = [0,3,7,9]
sevenSus2 :: Num a => [a]
sevenSus2 = [0,2,7,10]
sevenSus4 :: Num a => [a]
sevenSus4 = [0,5,7,10]
sevenFlat5 :: Num a => [a]
sevenFlat5 = [0,4,6,10]
m7flat5 :: Num a => [a]
m7flat5 = [0,3,6,10]
sevenSharp5 :: Num a => [a]
sevenSharp5 = [0,4,8,10]
m7sharp5 :: Num a => [a]
m7sharp5 = [0,3,8,10]
nine :: Num a => [a]
nine = [0,4,7,10,14]
m9 :: Num a => [a]
m9 = [0,3,7,10,14]
m7sharp9 :: Num a => [a]
m7sharp9 = [0,3,7,10,14]
maj9 :: Num a => [a]
maj9 = [0,4,7,11,14]
nineSus4 :: Num a => [a]
nineSus4 = [0,5,7,10,14]
sixby9 :: Num a => [a]
sixby9 = [0,4,7,9,14]
m6by9 :: Num a => [a]
m6by9 = [0,3,9,7,14]
sevenFlat9 :: Num a => [a]
sevenFlat9 = [0,4,7,10,13]
m7flat9 :: Num a => [a]
m7flat9 = [0,3,7,10,13]
sevenFlat10 :: Num a => [a]
sevenFlat10 = [0,4,7,10,15]
nineSharp5 :: Num a => [a]
nineSharp5 = [0,1,13]
m9sharp5 :: Num a => [a]
m9sharp5 = [0,1,14]
sevenSharp5flat9 :: Num a => [a]
sevenSharp5flat9 = [0,4,8,10,13]
m7sharp5flat9 :: Num a => [a]
m7sharp5flat9 = [0,3,8,10,13]
eleven :: Num a => [a]
eleven = [0,4,7,10,14,17]
m11 :: Num a => [a]
m11 = [0,3,7,10,14,17]
maj11 :: Num a => [a]
maj11 = [0,4,7,11,14,17]
evelenSharp :: Num a => [a]
evelenSharp = [0,4,7,10,14,18]
m11sharp :: Num a => [a]
m11sharp = [0,3,7,10,14,18]
thirteen :: Num a => [a]
thirteen = [0,4,7,10,14,17,21]
m13 :: Num a => [a]
m13 = [0,3,7,10,14,17,21]
-- | @chordate cs m n@ selects the @n@th "chord" (a chord is a list of Ints)
-- from a list of chords @cs@ and transposes it by @m@
chordate :: Num b => [[b]] -> b -> Int -> [b]
chordate cs m n = map (+m) $ cs!!n
-- | @enchord chords pn pc@ turns every note in the note pattern @pn@ into
-- a chord, selecting from the chord lists @chords@ using the index pattern
-- @pc@. For example, @Chords.enchord [Chords.major Chords.minor] "c g" "0 1"@
-- will create a pattern of a C-major chord followed by a G-minor chord.
enchord :: Num a => [[a]] -> Pattern a -> Pattern Int -> Pattern a
enchord chords pn pc = flatpat $ (chordate chords) <$> pn <*> pc
tidal-0.9.5/Sound/Tidal/Sieve.hs 0000644 0000000 0000000 00000007352 13212576414 014560 0 ustar 00 0000000 0000000 {-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -Wall -fno-warn-orphans -fno-warn-name-shadowing #-}
module Sound.Tidal.Sieve where
import Control.Applicative
import Data.Monoid
import Sound.Tidal.Parse
import Sound.Tidal.Pattern
import Sound.Tidal.Strategies
import Sound.Tidal.Time
-- The 'Sieve' datatype, which represents a Xenakis sieve.
-- (for an overview, see www.mitpressjournals.org/doi/pdf/10.1162/0148926054094396)
data Sieve a = Sieve {sieveAt :: Int -> a}
instance Functor Sieve where
fmap f s = Sieve $ \i -> f (sieveAt s i)
instance Applicative Sieve where
pure b = Sieve $ \i -> b
a <*> b = Sieve $ \i -> (sieveAt a i) (sieveAt b i)
-- | The basic notation for and constructor of a boolean 'Sieve' is @m\@\@n@,
-- which represents all integers whose modulo with @m@ is equal to @n@
infixl 9 @@
(@@) :: Int -> Int -> Sieve Bool
m @@ i = Sieve $ \j -> (j `mod` m) == i
-- If Haskell's logic operators had been defined on a type class, we could
-- declare Sieve to be an instance, but they haven't so here we are
-- | @not'@ gives the complement of a sieve
not' :: Applicative f => f Bool -> f Bool
not' = fmap not
-- | @#||#@ gives the union (logical OR) of two sieves
infixl 2 #||#
(#||#) :: Applicative f => f Bool -> f Bool -> f Bool
(#||#) = liftA2 (||)
-- | @#&&#@ gives the intersection (logical AND) of two sieves
infixl 3 #&&#
(#&&#) :: Applicative f => f Bool -> f Bool -> f Bool
(#&&#) = liftA2 (&&)
-- | `#^^#` gives the exclusive disjunction (logical XOR) of two sieves
infixl 2 #^^#
(#^^#) :: Applicative f => f Bool -> f Bool -> f Bool
(#^^#) x y = (x #&&# not' y) #||# (y #&&# not' x)
-- | @sieveToList n@ returns a list of the values of the sieve for each
-- nonnegative integer less than @n@
-- For example: @sieveToList 10 $ 3\@\@1@ returns
-- `[False, True, False, False, True, False, False, True, False, False]`
sieveToList :: Int -> Sieve a -> [a]
sieveToList n s = map (sieveAt s) [0..n-1]
-- | @sieveToString n@ represents the sieve as a character string, where
-- @-@ represents False and @x@ represents True
sieveToString :: Int -> Sieve Bool -> [Char]
sieveToString n s = map b2c $ sieveToList n s
where b2c b | b == True = 'x' | otherwise = '-'
-- | @sieveToInts n@ returns a list of nonnegative integers less than @n@
-- where the sieve is True
sieveToInts :: Int -> Sieve Bool -> [Int]
sieveToInts n s = map snd $ filter fst $ zip (sieveToList n s) [0..n-1]
-- | @sieveToPat n@ returns a pattern where the cycle is divided into @n@
-- beats, and there is an event whenever the matching beat number is in the
-- sieve
-- For example: @sieveToPat 8 $ 3\@\@1@ returns @"~ x ~ ~ x ~ ~ x"@
sieveToPat :: Int -> Sieve Bool -> Pattern String
sieveToPat n s = p $ concatMap b2s $ sieveToList n s where
b2s b | b == True = "x " | otherwise = "~ "
-- | @stepSieve n str@ works like 'sieveToPat' but uses @str@ in the pattern
-- instead of @x@
stepSieve :: Int -> String -> Sieve Bool -> Pattern String
stepSieve n str sieve = step str (sieveToString n sieve)
-- | @slowstepSieve t@ is shorthand for applying @slow t@ to the result of
-- `stepSieve`
slowstepSieve :: Pattern Time -> Int -> String -> Sieve Bool -> Pattern String
slowstepSieve t n str sieve = slow t $ stepSieve n str sieve
-- | @scaleSieve n@ uses 'sieveToInts' to turn a sieve into a list of
-- integers, and then uses that with the @toScale@ function to
-- turn a pattern of numbers into a pattern of notes in the scale.
-- For example: @scaleSieve 8 (3\@\@1) "0 1 2 1"@ first converts the sieve
-- to the scale @[1, 4, 7]@ and then uses that with @toScale@ to return the
-- pattern @"1 4 7 4"@
scaleSieve :: Int -> Sieve Bool -> Pattern Int -> Pattern Int
scaleSieve n sieve = toScale (sieveToInts n sieve)
instance Show (Sieve Bool) where
show = sieveToString 32
tidal-0.9.5/Sound/Tidal/Bjorklund.hs 0000644 0000000 0000000 00000002001 13212576414 015421 0 ustar 00 0000000 0000000 module Sound.Tidal.Bjorklund (bjorklund) where
-- The below is (c) Rohan Drape, taken from the hmt library and
-- distributed here under the terms of the GNU Public Licence. Tidal
-- used to just include the library but removed for now due to
-- dependency problems.. We could however likely benefit from other
-- parts of the library..
type STEP a = ((Int,Int),([[a]],[[a]]))
left :: STEP a -> STEP a
left ((i,j),(xs,ys)) =
let (xs',xs'') = splitAt j xs
in ((j,i-j),(zipWith (++) xs' ys,xs''))
right :: STEP a -> STEP a
right ((i,j),(xs,ys)) =
let (ys',ys'') = splitAt i ys
in ((i,j-i),(zipWith (++) xs ys',ys''))
bjorklund' :: STEP a -> STEP a
bjorklund' (n,x) =
let (i,j) = n
in if min i j <= 1
then (n,x)
else bjorklund' (if i > j then left (n,x) else right (n,x))
bjorklund :: (Int,Int) -> [Bool]
bjorklund (i,j') =
let j = j' - i
x = replicate i [True]
y = replicate j [False]
(_,(x',y')) = bjorklund' ((i,j),(x,y))
in concat x' ++ concat y'
tidal-0.9.5/Sound/Tidal/Strategies.hs 0000644 0000000 0000000 00000035726 13212576414 015625 0 ustar 00 0000000 0000000 {-# OPTIONS_GHC -XNoMonomorphismRestriction -XOverloadedStrings #-}
module Sound.Tidal.Strategies where
import Data.Ratio
import Control.Applicative
import qualified Data.Map as Map
import qualified Data.Char as Char
import Data.Fixed
import Data.Maybe
import Sound.Tidal.Dirt
import Sound.Tidal.Pattern
import Sound.Tidal.Stream
import Sound.Tidal.Time
import Sound.Tidal.Utils
import Sound.Tidal.Params
import Sound.Tidal.Parse
import Data.List (transpose)
stutter :: Integral i => i -> Time -> Pattern a -> Pattern a
stutter n t p = stack $ map (\i -> (t * (fromIntegral i)) `rotR` p) [0 .. (n-1)]
echo, triple, quad, double :: Time -> Pattern a -> Pattern a
echo = stutter 2
triple = stutter 3
quad = stutter 4
double = echo
{- | The `jux` function creates strange stereo effects, by applying a
function to a pattern, but only in the right-hand channel. For
example, the following reverses the pattern on the righthand side:
@
d1 $ slow 32 $ jux (rev) $ striate' 32 (1/16) $ sound "bev"
@
When passing pattern transforms to functions like [jux](#jux) and [every](#every),
it's possible to chain multiple transforms together with `.`, for
example this both reverses and halves the playback speed of the
pattern in the righthand channel:
@
d1 $ slow 32 $ jux ((# speed "0.5") . rev) $ striate' 32 (1/16) $ sound "bev"
@
-}
jux = juxBy 1
juxcut f p = stack [p # pan (pure 0) # cut (pure (-1)),
f $ p # pan (pure 1) # cut (pure (-2))
]
juxcut' fs p = stack $ map (\n -> ((fs !! n) p |+| cut (pure $ 1-n)) # pan (pure $ fromIntegral n / fromIntegral l)) [0 .. l-1]
where l = length fs
{- | In addition to `jux`, `jux'` allows using a list of pattern transform. resulting patterns from each transformation will be spread via pan from left to right.
For example:
@
d1 $ jux' [iter 4, chop 16, id, rev, palindrome] $ sound "bd sn"
@
will put `iter 4` of the pattern to the far left and `palindrome` to the far right. In the center the original pattern will play and mid left mid right the chopped and the reversed version will appear.
One could also write:
@
d1 $ stack [
iter 4 $ sound "bd sn" # pan "0",
chop 16 $ sound "bd sn" # pan "0.25",
sound "bd sn" # pan "0.5",
rev $ sound "bd sn" # pan "0.75",
palindrome $ sound "bd sn" # pan "1",
]
@
-}
jux' fs p = stack $ map (\n -> ((fs !! n) p) # pan (pure $ fromIntegral n / fromIntegral l)) [0 .. l-1]
where l = length fs
-- | Multichannel variant of `jux`, _not sure what it does_
jux4 f p = stack [p # pan (pure (5/8)), f $ p # pan (pure (1/8))]
{- |
With `jux`, the original and effected versions of the pattern are
panned hard left and right (i.e., panned at 0 and 1). This can be a
bit much, especially when listening on headphones. The variant `juxBy`
has an additional parameter, which brings the channel closer to the
centre. For example:
@
d1 $ juxBy 0.5 (density 2) $ sound "bd sn:1"
@
In the above, the two versions of the pattern would be panned at 0.25
and 0.75, rather than 0 and 1.
-}
juxBy n f p = stack [p |+| pan (pure $ 0.5 - (n/2)), f $ p |+| pan (pure $ 0.5 + (n/2))]
{- | Smash is a combination of `spread` and `striate` - it cuts the samples
into the given number of bits, and then cuts between playing the loop
at different speeds according to the values in the list.
So this:
@
d1 $ smash 3 [2,3,4] $ sound "ho ho:2 ho:3 hc"
@
Is a bit like this:
@
d1 $ spread (slow) [2,3,4] $ striate 3 $ sound "ho ho:2 ho:3 hc"
@
This is quite dancehall:
@
d1 $ (spread' slow "1%4 2 1 3" $ spread (striate) [2,3,4,1] $ sound
"sn:2 sid:3 cp sid:4")
# speed "[1 2 1 1]/2"
@
-}
smash n xs p = slowcat $ map (\n -> slow n p') xs
where p' = striate n p
{- | an altenative form to `smash` is `smash'` which will use `chop` instead of `striate`.
-}
smash' n xs p = slowcat $ map (\n -> slow n p') xs
where p' = _chop n p
-- samples "jvbass [~ latibro] [jvbass [latibro jvbass]]" ((1%2) `rotL` slow 6 "[1 6 8 7 3]")
samples :: Applicative f => f String -> f Int -> f String
samples p p' = pick <$> p <*> p'
samples' :: Applicative f => f String -> f Int -> f String
samples' p p' = (flip pick) <$> p' <*> p
{-
scrumple :: Time -> Pattern a -> Pattern a -> Pattern a
scrumple o p p' = p'' -- overlay p (o `rotR` p'')
where p'' = Pattern $ \a -> concatMap
(\((s,d), vs) -> map (\x -> ((s,d),
snd x
)
)
(arc p' (s,s))
) (arc p a)
-}
--rev :: Pattern a -> Pattern a
--rev p = Pattern $ \a -> concatMap
-- (\a' -> mapFsts mirrorArc $
-- (arc p (mirrorArc a')))
-- (arcCycles a)
--spreadf :: [Pattern a -> Pattern b] -> Pattern a -> Pattern b
spreadf ts p = spread ($)
{- | `spin` will "spin" a layer up a pattern the given number of times, with each successive layer offset in time by an additional `1/n` of a cycle, and panned by an additional `1/n`. The result is a pattern that seems to spin around. This function works best on multichannel systems.
@
d1 $ slow 3 $ spin 4 $ sound "drum*3 tabla:4 [arpy:2 ~ arpy] [can:2 can:3]"
@
-}
spin :: Pattern Int -> ParamPattern -> ParamPattern
spin = temporalParam _spin
_spin :: Int -> ParamPattern -> ParamPattern
_spin copies p =
stack $ map (\n -> let offset = toInteger n % toInteger copies in
offset `rotL` p
# pan (pure $ fromRational offset)
)
[0 .. (copies - 1)]
{-stripe :: Arc -> Pattern a -> Pattern a
stripe (stripeS, stripeE) p = slow t $ Pattern $ \a -> concatMap f $ arcCycles a
where f a = mapFsts (stretch . stripe') $ arc p (stripe' a)
trunc' (s,e) = (min s ((sam s) + t), min e ((sam s) + t))
stretch (s,e) = (sam s + ((s - sam s) / t), sam s + ((e - sam s) / t))
-}
sawwave4, sinewave4, rand4 :: Pattern Double
sawwave4 = ((*4) <$> sawwave1)
sinewave4 = ((*4) <$> sinewave1)
rand4 = ((*4) <$> rand)
stackwith p ps | null ps = silence
| otherwise = stack $ map (\(i, p') -> p' # (((fromIntegral i) % l) `rotL` p)) (zip [0 ..] ps)
where l = fromIntegral $ length ps
{-
cross f p p' = Pattern $ \t -> concat [filter flt $ arc p t,
filter (not . flt) $ arc p' t
]
] where flt = f . cyclePos . fst . fst
-}
{- | `scale` will take a pattern which goes from 0 to 1 (like `sine1`), and scale it to a different range - between the first and second arguments. In the below example, `scale 1 1.5` shifts the range of `sine1` from 0 - 1 to 1 - 1.5.
@
d1 $ jux (iter 4) $ sound "arpy arpy:2*2"
|+| speed (slow 4 $ scale 1 1.5 sine1)
@
-}
scale :: (Functor f, Num b) => b -> b -> f b -> f b
scale from to p = ((+ from) . (* (to-from))) <$> p
{- | `scalex` is an exponential version of `scale`, good for using with
frequencies. Do *not* use negative numbers or zero as arguments! -}
scalex :: (Functor f, Floating b) => b -> b -> f b -> f b
scalex from to p = exp <$> scale (log from) (log to) p
{- | `chop` granualizes every sample in place as it is played, turning a pattern of samples into a pattern of sample parts. Use an integer value to specify how many granules each sample is chopped into:
@
d1 $ chop 16 $ sound "arpy arp feel*4 arpy*4"
@
Different values of `chop` can yield very different results, depending
on the samples used:
@
d1 $ chop 16 $ sound (samples "arpy*8" (run 16))
d1 $ chop 32 $ sound (samples "arpy*8" (run 16))
d1 $ chop 256 $ sound "bd*4 [sn cp] [hh future]*2 [cp feel]"
@
-}
chop :: Pattern Int -> ParamPattern -> ParamPattern
chop = temporalParam _chop
_chop :: Int -> ParamPattern -> ParamPattern
_chop n p = Pattern $ \queryA -> concatMap (f queryA) $ arcCycles queryA
where f queryA a = concatMap (chopEvent queryA) (arc p a)
chopEvent (queryS, queryE) (a,_a',v) = map (newEvent v) $ filter (\(_, (s,e)) -> not $ or [e < queryS, s >= queryE]) (enumerate $ chopArc a n)
newEvent :: ParamMap -> (Int, Arc) -> Event ParamMap
newEvent v (i, a) = (a,a,Map.insert (param dirt "end") (VF ((fromIntegral $ i+1)/(fromIntegral n))) $ Map.insert (param dirt "begin") (VF ((fromIntegral i)/(fromIntegral n))) v)
{- | `gap` is similar to `chop` in that it granualizes every sample in place as it is played,
but every other grain is silent. Use an integer value to specify how many granules
each sample is chopped into:
@
d1 $ gap 8 $ sound "jvbass"
d1 $ gap 16 $ sound "[jvbass drum:4]"
@-}
gap :: Pattern Int -> ParamPattern -> ParamPattern
gap = temporalParam _gap
_gap :: Int -> ParamPattern -> ParamPattern
_gap n p = Pattern $ \queryA -> concatMap (f queryA) $ arcCycles queryA
where f queryA a = concatMap (chopEvent queryA) (arc p a)
chopEvent (queryS, queryE) (a,_a',v) = map (newEvent v) $ filter (\(_, (s,e)) -> not $ or [e < queryS, s >= queryE]) (enumerate $ everyOther $ chopArc a n)
newEvent :: ParamMap -> (Int, Arc) -> Event ParamMap
newEvent v (i, a) = (a,a,Map.insert (param dirt "end") (VF ((fromIntegral $ i+1)/(fromIntegral n))) $ Map.insert (param dirt "begin") (VF ((fromIntegral i)/(fromIntegral n))) v)
everyOther (x:_:xs) = x:everyOther xs
everyOther xs = xs
chopArc :: Arc -> Int -> [Arc]
chopArc (s, e) n = map (\i -> ((s + (e-s)*(fromIntegral i/fromIntegral n)), s + (e-s)*((fromIntegral $ i+1)/fromIntegral n))) [0 .. n-1]
{-
normEv :: Event a -> Event a -> Event a
normEv ev@(_, (s,e), _) ev'@(_, (s',e'), _)
| not on && not off = [] -- shouldn't happen
| on && off = splitEv ev'
| not on && s' > sam s = []
| not off && e' < nextSam s = [(fst' ev, mapSnd' (mapSnd (min $ nextSam s)) ev, thd' ev)]
where on = onsetIn (sam s, nextSam s) ev
off = offsetIn (sam s, nextSam s) ev
eplitEv
-}
--mapCycleEvents :: Pattern a -> ([Event a] -> [Event a]) -> Pattern a
--mapCycleEvents p f = splitQueries $ Pattern $ \(s,e) -> filter (\ev -> isJust $ subArc (s,e) (eventArc ev)) $ f $ arc p (sam s, nextSam s)
--off :: Time -> Pattern a -> Pattern a
--off t p = mapCycleEvents p (mapArcs (mapSnd wrappedPlus . mapFst wrappedPlus))
-- where wrapAtCycle f t' = sam t' + cyclePos (f t')
-- wrappedPlus = wrapAtCycle (+t)
en :: [(Int, Int)] -> Pattern String -> Pattern String
en ns p = stack $ map (\(i, (k, n)) -> e k n (samples p (pure i))) $ enumerate ns
{- |
`weave` applies a function smoothly over an array of different patterns. It uses an `OscPattern` to
apply the function at different levels to each pattern, creating a weaving effect.
@
d1 $ weave 3 (shape $ sine1) [sound "bd [sn drum:2*2] bd*2 [sn drum:1]", sound "arpy*8 ~"]
@
-}
weave :: Rational -> ParamPattern -> [ParamPattern] -> ParamPattern
weave t p ps = weave' t p (map (\x -> (x #)) ps)
{- | `weave'` is similar in that it blends functions at the same time at different amounts over a pattern:
@
d1 $ weave' 3 (sound "bd [sn drum:2*2] bd*2 [sn drum:1]") [density 2, (# speed "0.5"), chop 16]
@
-}
weave' :: Rational -> Pattern a -> [Pattern a -> Pattern a] -> Pattern a
weave' t p fs | l == 0 = silence
| otherwise = _slow t $ stack $ map (\(i, f) -> (fromIntegral i % l) `rotL` (_density t $ f (_slow t p))) (zip [0 ..] fs)
where l = fromIntegral $ length fs
{- |
(A function that takes two OscPatterns, and blends them together into
a new OscPattern. An OscPattern is basically a pattern of messages to
a synthesiser.)
Shifts between the two given patterns, using distortion.
Example:
@
d1 $ interlace (sound "bd sn kurt") (every 3 rev $ sound "bd sn:2")
@
-}
interlace :: ParamPattern -> ParamPattern -> ParamPattern
interlace a b = weave 16 (shape $ ((* 0.9) <$> sinewave1)) [a, b]
-- | Step sequencing
step :: String -> String -> Pattern String
step s steps = fastcat $ map f steps
where f c | c == 'x' = atom s
| c >= '0' && c <= '9' = atom $ s ++ ":" ++ [c]
| otherwise = silence
steps :: [(String, String)] -> Pattern String
steps = stack . map (\(a,b) -> step a b)
-- | like `step`, but allows you to specify an array of strings to use for 0,1,2...
step' :: [String] -> String -> Pattern String
step' ss steps = fastcat $ map f steps
where f c | c == 'x' = atom $ ss!!0
| c >= '0' && c <= '9' = atom $ ss!!(Char.digitToInt c)
| otherwise = silence
off :: Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
off tp f p = unwrap $ (\tv -> _off tv f p) <$> tp
_off :: Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_off t f p = superimpose (f . (t `rotR`)) p
offadd :: Num a => Pattern Time -> Pattern a -> Pattern a -> Pattern a
offadd tp pn p = off tp (+pn) p
{- | `up` does a poor man's pitchshift by semitones via `speed`.
You can easily produce melodies from a single sample with up:
@
d1 # up "0 5 4 12" # sound "arpy"
@
This will play the _arpy_ sample four times a cycle in the original pitch, pitched by 5 semitones, by 4 and then by an octave.
-}
up :: Pattern Double -> ParamPattern
up = speed . ((1.059466**) <$>)
ghost'' a f p = superimpose (((a*2.5) `rotR`) . f) $ superimpose (((a*1.5) `rotR`) . f) $ p
ghost' a p = ghost'' 0.125 ((|*| gain (pure 0.7)) . (|=| end (pure 0.2)) . (|*| speed (pure 1.25))) p
ghost p = ghost' 0.125 p
slice :: Int -> Int -> ParamPattern -> ParamPattern
slice i n p =
p
# begin (pure $ fromIntegral i / fromIntegral n)
# end (pure $ fromIntegral (i+1) / fromIntegral n)
randslice :: Int -> ParamPattern -> ParamPattern
randslice n p = unwrap $ (\i -> slice i n p) <$> irand n
{- |
`loopAt` makes a sample fit the given number of cycles. Internally, it
works by setting the `unit` parameter to "c", changing the playback
speed of the sample with the `speed` parameter, and setting setting
the `density` of the pattern to match.
@
d1 $ loopAt 4 $ sound "breaks125"
d1 $ juxBy 0.6 (|*| speed "2") $ slowspread (loopAt) [4,6,2,3] $ chop 12 $ sound "fm:14"
@
-}
loopAt :: Pattern Time -> ParamPattern -> ParamPattern
loopAt n p = slow n p |*| speed (fromRational <$> (1/n)) # unit (pure "c")
{- |
tabby - A more literal weaving than the `weave` function, give number
of 'threads' per cycle and two patterns, and this function will weave them
together using a plain (aka 'tabby') weave, with a simple over/under structure
-}
tabby n p p' = stack [maskedWarp n p,
maskedWeft n p'
]
where
weft n = concatMap (\x -> [[0..n-1],(reverse [0..n-1])]) [0 .. (n `div` 2) - 1]
warp = transpose . weft
thread xs n p = _slow (n%1) $ fastcat $ map (\i -> zoom (i%n,(i+1)%n) p) (concat xs)
weftP n p = thread (weft n) n p
warpP n p = thread (warp n) n p
maskedWeft n p = Sound.Tidal.Pattern.mask (every 2 rev $ _density ((n)%2) "~ 1" :: Pattern Int) $ weftP n p
maskedWarp n p = mask (every 2 rev $ _density ((n)%2) "1 ~" :: Pattern Int) $ warpP n p
hurry :: Pattern Rational -> ParamPattern -> ParamPattern
hurry x = (|*| speed (fromRational <$> x)) . fast x
tidal-0.9.5/doc/ 0000755 0000000 0000000 00000000000 13212576414 011562 5 ustar 00 0000000 0000000 tidal-0.9.5/doc/tidal.md 0000644 0000000 0000000 00000000113 13212576414 013174 0 ustar 00 0000000 0000000 Documentation has now moved to the Tidal website:
http://tidal.lurk.org/