;;; Go-Music

(defconst go-music-scale-minor
  '("d" "es" "g" "a" "b"))

(defconst go-music-scale-major
  '("d" "e" "g" "a" "h"))

(defvar go-music-scale
  go-music-scale-minor
  "*The tuning scale used by GO-MUSIC.")

(defvar go-music-last-move)

(defun go-music-write-header (black white title)
  (insert "% Generated by GO-MUSIC\n"
          "\\include \"deutsch.ly\"\n"
          "\\version \"2.8.1\"\n"
          "\n"
          "\\header {\n"
          "  composer = \"" black " and " white "\"\n"
          "  title = \"" title "\"\n"
          "}\n"
          "\n"
          "music = \\context Staff {"
          "  \\set Staff.midiInstrument = \"koto\"\n "))

(defun go-music-convert-xy (move)
  (list (- (downcase (elt move 0)) ?a)
        (- (downcase (elt move 1)) ?a)))

(defun go-music-create-note (x y)
  (if (and (= x 19) (= y 19))
      (apply 'concat
             (append (mapcar '(lambda (x) (concat x "''32 "))
                             (reverse go-music-scale))
                     (mapcar '(lambda (x) (concat x "'32 "))
                             (reverse go-music-scale))
                     (mapcar '(lambda (x) (concat x "32 "))
                             (reverse go-music-scale))))
    (let ((length (if (> (max (abs (- x (first go-music-last-move)))
                              (abs (- y (second go-music-last-move))))
                         5)
                      4
                    8)))
      (setq go-music-last-move (list x y))
      (let ((n (length go-music-scale))
            (height (+ (if (> x 9) (- 18 x) x) (if (> y 9) (- 18 y) y))))
        (concat (nth (mod height n) go-music-scale)
                (let ((octave (floor (/ height n))))
                  (cond ((= octave 0) "")
                        ((= octave 1) "'")
                        ((= octave 2) "''")
                        (t "'''")))
                (format "%d" length))))))

(defun go-music-write-note (note)
  (when (> (current-column) 50)
    (insert "\n "))
  (insert " " note))

(defun go-music-write-footer ()
  (insert "\n"
          "}\n"
          "\n"
          "\\score {\n"
          "  <<\n"
          "    \\new Staff \\music\n"
          "  >>\n"
          "  \\layout { }\n"
          "  \\midi { \\tempo 4 = 120 }\n"
          "}\n"))

(defun go-music-find-sgf-tag (tag)
  (and (re-search-forward (concat tag "\\[\\([^]]*\\)\\]") (point-max) t)
       (match-string 1)))

(defun go-music ()
  "Generate music from a Go game.
Should be called in an open SGF buffer.
The result is a 2.8.1-compliant LilyPond file, producing sheet music and MIDI."
  (interactive)
  (let ((ly-buf (generate-new-buffer "*go-music*")))
    (save-excursion
      (goto-char (point-min))
      (let ((name (buffer-name))
            (black (save-excursion (go-music-find-sgf-tag "PB")))
            (white (save-excursion (go-music-find-sgf-tag "PW"))))
        (save-excursion
          (set-buffer ly-buf)
          (go-music-write-header black white name)))
      (setq go-music-last-move '(100 100))
      (let ((next-move (go-music-find-sgf-tag ";[BW]")))
        (while next-move
          (save-excursion
            (set-buffer ly-buf)
            (go-music-write-note (apply 'go-music-create-note
                                        (go-music-convert-xy next-move))))
          (setq next-move (go-music-find-sgf-tag ";[BW]")))))
    (save-excursion
      (set-buffer ly-buf)
      (go-music-write-footer))
    (switch-to-buffer ly-buf)
    (LilyPond-mode)))