Created
May 15, 2021 19:20
-
-
Save ahihi/73561c95685aeec6c0e78eda3138c700 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;;; 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 <https://www.gnu.org/licenses/>. | |
;;; 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) | |
(require 'subr-x) | |
(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-version | |
(substring (shell-command-to-string (concat tidal-interpreter " --numeric-version")) 0 -1) | |
"*The version of tidal interpreter as a string.") | |
(defvar tidal-interpreter-arguments | |
() | |
"*Arguments to the haskell interpreter (default=none).") | |
(defvar tidal-boot-script-path | |
;; (let ((filepath | |
;; (cond | |
;; ((string-equal system-type "windows-nt") | |
;; '(("path" . "echo off && for /f %a in ('ghc-pkg latest tidal') do (for /f \"tokens=2\" %i in ('ghc-pkg describe %a ^| findstr data-dir') do (echo %i))") | |
;; ("separator" . "\\") | |
;; )) | |
;; ((or (string-equal system-type "darwin") (string-equal system-type "gnu/linux")) | |
;; '(("path" . "ghc-pkg field tidal data-dir") | |
;; ("separator" . "/") | |
;; )) | |
;; ) | |
;; )) | |
;; (concat | |
;; (string-trim (cadr (split-string | |
;; (shell-command-to-string (cdr (assoc "path" filepath))) ":"))) | |
;; (cdr (assoc "separator" filepath)) | |
;; "BootTidal.hs") | |
;; ) | |
;; | |
(let ((path (shell-command-to-string "find ~/.cabal -name BootTidal.hs | tail -n 1"))) | |
(if (string= "" path) nil path)) | |
"*Full path to BootTidal.hs (inferred by introspecting ghc-pkg package db).") | |
(defvar tidal-init-script-path nil | |
"*Full path to InitTidal.hs (executed after BootTidal.hs).") | |
(defvar tidal-literate-p | |
t | |
"*Flag to indicate if we are in literate mode (default=t).") | |
(make-variable-buffer-local 'tidal-literate-p) | |
(defvar tidal-modules nil | |
"Additional module imports. See `tidal-run-region'.") | |
(defun tidal-new-d-instances () (mapcar (lambda (x) (cons x 1)) (number-sequence 1 10))) | |
(defvar tidal-d-instances (tidal-new-d-instances)) | |
(make-variable-buffer-local 'tidal-d-instances) | |
(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 (concat ":script " tidal-boot-script-path)) | |
(when tidal-init-script-path | |
(tidal-send-string (concat ":script " tidal-init-script-path))) | |
) | |
(defun tidal-see-output () | |
"Show haskell output." | |
(interactive) | |
(when (comint-check-proc tidal-buffer) | |
;; (delete-other-windows) | |
(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"))) | |
(buf (current-buffer))) | |
(set-buffer tidal-buffer) | |
(delete-region (point-min) (point-max)) | |
(set-buffer buf) | |
(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-detect-d-and-instance () | |
"Detect the d and instance number of the current paragraph." | |
(interactive) | |
(mark-paragraph) | |
(let ((start (region-beginning)) | |
(end (region-end))) | |
(if (re-search-forward "d\\([0-9]+\\)" end t) | |
(let ((n (string-to-number (match-string 1))) | |
(i 0) | |
(found nil)) | |
(flet ((find-next-instance () | |
(interactive) | |
(search-forward (concat "d" (number-to-string n)) nil nil 1) | |
(setq i (+ i 1)) | |
(if (and (<= start (point)) (< (point) end)) | |
(setq found t)))) | |
(goto-char 0) | |
(while (not found) | |
(find-next-instance)) | |
(list n i)))))) | |
(defun tidal-detect-and-register-d-and-instance () | |
"Detect the d and instance number of the current paragraph, and register them in tidal-d-instances." | |
(interactive) | |
(let ((d-and-instance (tidal-detect-d-and-instance))) | |
(if d-and-instance | |
(destructuring-bind (n i) d-and-instance | |
(tidal-register-d-instance n i))))) | |
(defun tidal-run-multiple-lines (&optional skip-detect-and-register) | |
"Send the current region to the interpreter as a single line." | |
(interactive) | |
(let ((run (lambda () (interactive) | |
(if (not skip-detect-and-register) (tidal-detect-and-register-d-and-instance)) | |
(tidal-eval-multiple-lines)))) | |
(if (>= emacs-major-version 25) | |
(save-mark-and-excursion | |
(funcall-interactively run)) | |
(save-excursion | |
(funcall-interactively run))))) | |
(defun tidal-run-d (n &optional i) | |
"Send the ith instance of dn to the interpreter as a single line." | |
(interactive) | |
(let ((i (or i 1))) | |
(goto-char 0) | |
(search-forward (concat "d" (number-to-string n)) nil nil i) | |
(tidal-run-multiple-lines t))) | |
(defun tidal-reset-d-instances () | |
"Reset tidal-d-instances to default values (instance number 1 for each d)." | |
(interactive) | |
(setq tidal-d-instances (tidal-new-d-instances))) | |
(tidal-reset-d-instances) | |
(defun tidal-register-d-instance (n i) | |
"Register i as the instance for dn." | |
(interactive) | |
(message "d%d: register instance %d" n i) | |
(setf (cdr (assoc n tidal-d-instances)) i)) | |
(defun tidal-run-d-instance (n) | |
"Run the registered dn instance." | |
(interactive) | |
(tidal-run-d n (cdr (assoc n tidal-d-instances)))) | |
(defun tidal-register-and-run-d-instance (n &optional i) | |
"Register i as the instance for dn and run it." | |
(interactive) | |
(if i (tidal-register-d-instance n i)) | |
(tidal-run-d-instance n)) | |
(defun tidal-stop-d (n &optional fade) | |
"Stop dn. If fade > 0, fade out over that many cycles." | |
(interactive) | |
(tidal-send-string ":{") | |
(let* ((fade (or fade 0)) | |
(code (if (< 0 fade) | |
(concat "fadeOut " (number-to-string n) " " (number-to-string fade)) | |
(concat "($ silence) d" (number-to-string n))))) | |
(tidal-send-string code)) | |
(tidal-send-string ":}")) | |
(defun tidal-run-d1 (i) | |
"Run the registered instance for d1. If the prefix argument is specified, first register it as the instance." | |
(interactive "P") | |
(tidal-register-and-run-d-instance 1 i)) | |
(defun tidal-run-d2 (i) | |
"Run the registered instance for d2. If the prefix argument is specified, first register it as the instance." | |
(interactive "P") | |
(tidal-register-and-run-d-instance 2 i)) | |
(defun tidal-run-d3 (i) | |
"Run the registered instance for d3. If the prefix argument is specified, first register it as the instance." | |
(interactive "P") | |
(tidal-register-and-run-d-instance 3 i)) | |
(defun tidal-run-d4 (i) | |
"Run the registered instance for d4. If the prefix argument is specified, first register it as the instance." | |
(interactive "P") | |
(tidal-register-and-run-d-instance 4 i)) | |
(defun tidal-run-d5 (i) | |
"Run the registered instance for d5. If the prefix argument is specified, first register it as the instance." | |
(interactive "P") | |
(tidal-register-and-run-d-instance 5 i)) | |
(defun tidal-run-d6 (i) | |
"Run the registered instance for d6. If the prefix argument is specified, first register it as the instance." | |
(interactive "P") | |
(tidal-register-and-run-d-instance 6 i)) | |
(defun tidal-run-d7 (i) | |
"Run the registered instance for d7. If the prefix argument is specified, first register it as the instance." | |
(interactive "P") | |
(tidal-register-and-run-d-instance 7 i)) | |
(defun tidal-run-d8 (i) | |
"Run the registered instance for d8. If the prefix argument is specified, first register it as the instance." | |
(interactive "P") | |
(tidal-register-and-run-d-instance 8 i)) | |
(defun tidal-run-d9 (i) | |
"Run the registered instance for d9. If the prefix argument is specified, first register it as the instance." | |
(interactive "P") | |
(tidal-register-and-run-d-instance 9 i)) | |
(defun tidal-run-d10 (i) | |
"Run the registered instance for d10. If the prefix argument is specified, first register it as the instance." | |
(interactive "P") | |
(tidal-register-and-run-d-instance 10 i)) | |
(defun tidal-stop-d1 (fade) | |
"Stop d1. If the prefix argument is specified, fade out over that many cycles." | |
(interactive "P") | |
(tidal-stop-d 1 fade)) | |
(defun tidal-stop-d2 (fade) | |
"Stop d2. If the prefix argument is specified, fade out over that many cycles." | |
(interactive "P") | |
(tidal-stop-d 2 fade)) | |
(defun tidal-stop-d3 (fade) | |
"Stop d3. If the prefix argument is specified, fade out over that many cycles." | |
(interactive "P") | |
(tidal-stop-d 3 fade)) | |
(defun tidal-stop-d4 (fade) | |
"Stop d4. If the prefix argument is specified, fade out over that many cycles." | |
(interactive "P") | |
(tidal-stop-d 4 fade)) | |
(defun tidal-stop-d5 (fade) | |
"Stop d5. If the prefix argument is specified, fade out over that many cycles." | |
(interactive "P") | |
(tidal-stop-d 5 fade)) | |
(defun tidal-stop-d6 (fade) | |
"Stop d6. If the prefix argument is specified, fade out over that many cycles." | |
(interactive "P") | |
(tidal-stop-d 6 fade)) | |
(defun tidal-stop-d7 (fade) | |
"Stop d7. If the prefix argument is specified, fade out over that many cycles." | |
(interactive "P") | |
(tidal-stop-d 7 fade)) | |
(defun tidal-stop-d8 (fade) | |
"Stop d8. If the prefix argument is specified, fade out over that many cycles." | |
(interactive "P") | |
(tidal-stop-d 8 fade)) | |
(defun tidal-stop-d9 (fade) | |
"Stop d9. If the prefix argument is specified, fade out over that many cycles." | |
(interactive "P") | |
(tidal-stop-d 9 fade)) | |
(defun tidal-stop-d10 (fade) | |
"Stop d10. If the prefix argument is specified, fade out over that many cycles." | |
(interactive "P") | |
(tidal-stop-d 10 fade)) | |
(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 "<C-return>") '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 "<C-return>") '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 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment