csound-score.el

;;; csound-score.el --- A major mode for interacting and coding Csound -*- lexical-binding: t; -*-

;; Copyright (C) 2017 - 2023  Hlöðver Sigurðsson

;; Author: Hlöðver Sigurðsson <hlolli@gmail.com>
;; Version: 0.2.9
;; Package-Requires: ((emacs "27.1"))
;; URL: https://github.com/hlolli/csound-mode

;; 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 <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This fine includes all helpers and handling of csound-score events
;; for interactive composition

;;; Code:

(require 'csound-font-lock)
(require 'csound-util)
(require 'font-lock)

(defun csound-score--align-cols (start end)
  (save-excursion
    (let ((line-end (line-number-at-pos end))
          (max-matrix '()))
      ;; Create matrix of max lengths
      (let ((statements
             (split-string
              (substring-no-properties (buffer-substring start end))
              "\n")))
        (dolist (stm statements)
          ;; Remove comments and extra whitespaces
          (let* ((stm*
                  (replace-regexp-in-string
                   "\\s-+" " "
                   (replace-regexp-in-string
                    "\\[[^]]*]"
                    (lambda (x) (replace-regexp-in-string "\\s-" "_" x))
                    (csound-util-chomp
                     (replace-regexp-in-string "\\(;\\|//\\).*" "" stm)))))
                 (param-list (split-string stm* " "))
                 ;; (param-num (length param-list))
                 (max-matrix-len (length max-matrix))
                 (index 0))
            ;; (print stm*)
            (dolist (param param-list)
              (if (<= max-matrix-len index)
                  (setq max-matrix (append max-matrix (list (length param)))
                        index (1+ index))
                (progn
                  (setf (nth index max-matrix)
                        (max (length param)
                             (nth index max-matrix)))
                  (setq index (1+ index))))))))
      ;; Align the block
      (goto-char start)
      (while (<= (line-number-at-pos) line-end)
        (beginning-of-line)
        ;; Add a space before comment if non
        (save-excursion
          (if (and (re-search-forward "\\(^\\|.\\)\\(;\\|//\\)" (line-end-position) t)
                   (save-match-data (string-match "\\S-" (match-string 1))))
            (replace-match "\\1 \\2")))
        ;; Align the line
        (let ((line-num (line-number-at-pos))
              (param-length 0)
              (index -1))
          (while (= (line-number-at-pos) line-num)
            ;; Align the parameter
            (let* ((margin-length (skip-chars-forward "[:space:]"))
                   (before-comment (looking-at ";\\|//"))
                   (spaces-to-add
                    (if (or (zerop param-length) (eolp))
                        ;; after line beginning or before line end
                        (- margin-length)
                      (- (if before-comment
                             ;; needed length before comment
                             (let ((subvec (nthcdr index max-matrix)))
                               (+ (apply #'+ subvec) (length subvec) 1))
                           ;; needed length before next parameter
                           (1+ (nth index max-matrix)))
                         ;; current length
                         (+ param-length margin-length)))))
              ;; Adjust the margin
              (if (< 0 spaces-to-add)
                  (insert (make-string spaces-to-add ?\040))
                (delete-char spaces-to-add))
              (if before-comment
                  (forward-line)
                (let ((ex-length
                       ;; length of [expression] before ]
                       (if (looking-at "\\[") (skip-chars-forward "^]") 0)))
                  ;; Move to the end of next parameter and get the length
                  (setq param-length
                        (+ ex-length (skip-chars-forward "^[:space:]")))
                  (setq index (1+ index))))
              ;; Exit loop at buffer end
              (if (eobp)
                  (setq line-num 0
                        line-end 0)))))))))

(defun csound-score-align-block ()
  "Align score block so that all parameter are of same space width."
  (interactive)
  (let ((re "^\\s-*[[:alpha:]$]"))
    (if (save-excursion
          ;; See if point is on an score event line
          (beginning-of-line)
          (re-search-forward re (line-end-position) t))
        (let ((beginning-of-block
               (save-excursion
                 ;; Search for beginning of block
                 (beginning-of-line)
                 (while (re-search-backward re (line-beginning-position 0) t)
                   (beginning-of-line))
                 (point)))
              (end-of-block
               (save-excursion
                 ;; Search for end of block
                 (end-of-line)
                 (while (re-search-forward re (line-end-position 2) t)
                   (end-of-line))
                 (point))))
          (csound-score--align-cols beginning-of-block end-of-block)))))

(defun csound-score--statement-timing (fields)
  "Return timing metadata for a timed score statement in FIELDS.
The return value is (TYPE P2-INDEX P3-INDEX), with indexes adjusted
for both `i 1 0 1' and `i1 0 1' score syntax."
  (let ((first-field (car fields)))
    (cond
     ((member first-field '("a" "d" "f" "i" "q"))
      (list first-field 2 3))
     ((and first-field
           (< 1 (length first-field))
           (member (substring first-field 0 1) '("a" "d" "f" "i" "q")))
      (list (substring first-field 0 1) 1 2)))))

(defun csound-score-trim-time (score-string)
  "Move timed statements in SCORE-STRING to start at time zero.
Both joined and separated score characters are accepted, such as
`i1 0 1' and `i 1 0 1'.  Resolve `+' and `.' start-time shorthand
while preserving the original score-character style."
  (let ((lines (split-string (substring-no-properties score-string) "\n"))
        (last-p2 nil)
        (last-p3 0)
        (p2-list '())
        (statements '()))
    (dolist (line lines)
      (let* ((fields (split-string
                      (replace-regexp-in-string
                       "\\s-+" " " (csound-util-chomp line))
                      " " t))
             (timing (csound-score--statement-timing fields))
             (type (car timing))
             (p2-index (nth 1 timing))
             (p3-index (nth 2 timing))
             (p2-field (and p2-index (nth p2-index fields)))
             (p2 (and p2-field
                      (cond
                       ((string-equal p2-field "+")
                        (+ (or last-p2 0) last-p3))
                       ((string-equal p2-field ".")
                        (or last-p2 0))
                       (t (string-to-number p2-field))))))
        (when p2
          (push p2 p2-list)
          (setq last-p2 p2))
        ;; Only an i statement's p3 is a duration.  Other timed statements
        ;; use p3 differently and must not affect a following `i ... + ...'.
        (when (and (string-equal type "i")
                   p3-index
                   (nth p3-index fields)
                   (not (string-equal (nth p3-index fields) ".")))
          (setq last-p3 (string-to-number (nth p3-index fields))))
        (push (list fields timing p2) statements)))
    (let ((min-p2 (if p2-list (apply #'min p2-list) 0)))
      (concat
       (mapconcat
        (lambda (statement)
          (let ((fields (nth 0 statement))
                (timing (nth 1 statement))
                (p2 (nth 2 statement)))
            (when p2
              (setf (nth (nth 1 timing) fields)
                    (number-to-string (- p2 min-p2))))
            (string-join fields " ")))
        (reverse statements)
        "\n")
       "\n"))))

(defvar csound-score--last-start)

(defvar csound-score--last-end)

(defun csound-score--flash ()
  (csound-util-flash-region
   csound-score--last-start
   csound-score--last-end
   'font-lock-string-face))

(defun csound-score-find-instr-def ()
  "For a score statement,
   jump the cursor to where
   its defined in the orchestra.
   Sets a mark."
  (interactive)
  (let* ((instr-on-line (save-excursion
                          (beginning-of-line)
                          (search-forward-regexp "\\<i\\s-?\\(\\\".*\\\"\\|[0-9]+\\)"
                                                 (line-end-position) t 1)
                          (match-string-no-properties 1)))
         (instr-on-line (replace-regexp-in-string "\\\"" "" instr-on-line))
         (search-attempt (save-excursion
                           (goto-char 0)
                           (search-forward-regexp (format "\\<instr\\s-+%s" instr-on-line) nil t 1))))
    (if search-attempt
        (progn (goto-char search-attempt)
               (setq csound-score--last-start (- (point) (length (thing-at-point 'symbol)))
                     csound-score--last-end (1- (point)))
               (csound-score--flash)
               (recenter-top-bottom))
      (message "instrument: %s not found in buffer" instr-on-line))))


(provide 'csound-score)

;;; csound-score.el ends here