;;; rcirc-voirc.el --- VoIRC for rcirc  -*- lexical-binding: t; -*-

;; Copyright (C) 2024  Philip Kaludercic

;; Author: Philip Kaludercic <philip.kaludercic@fau.de>
;; Maintainer: Philip Kaludercic <philip.kaludercic@fau.de>
;; URL: https://wwwcip.cs.fau.de/~oj14ozun/src+etc/rcirc-voirc.el
;; Version: $Id: rcirc-voirc.el,v 1.5 2024/02/21 14:14:49 oj14ozun Exp $
;; Package-Requires: ((emacs "26.1"))
;; Package-Version: 1

;; 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:

;; Elisp implementation of the VoIRC[0] "protocol", with support for
;; Rcirc (see Info node `(rcirc) Top').  Enable support for Rcirc by
;; enabling the `rcirc-voirc-mode' minor mode in a Rcirc buffer.

;; This script requires FFmpeg[1] (i.e. the "ffmpeg" and "ffplay"
;; programmes to be available in PATH) built with Codec2[2] support.

;; [0] https://github.com/asiekierka/voirc
;; [1] https://ffmpeg.org/
;; [2] https://www.rowetel.com/?page_id=452

;;; Code:

(require 'cl-lib)
(require 'rcirc)

(defgroup rcirc-voirc ()
  "VoIRC for rcirc."
  :group 'rcirc)

(defcustom rcirc-voirc-source "pulse"
  "Name of the FFmpeg source to use for recording."
  :type '(choice (const :tag "Use PulseAudio" "pulse")
		 (const :tag "Use ALSA" "alsa")
		 (string :tag "Other FFmpeg source")))

(defcustom rcirc-voirc-input "default"
  "Name of the FFmpeg input to use for recording."
  :type 'string)

(defcustom rcirc-voirc-sample-rate 8000
  "Sample rate of the input."
  :type 'natnum)
     
(defcustom rcirc-voirc-codec2-mode 8
  "FFmpeg name of the Codec2 mode to use."
  :type '(choice (const :tag "3200" 0)
		 (const :tag "2400" 1)
		 (const :tag "1600" 2)
		 (const :tag "1400" 3)
		 (const :tag "1300" 4)
		 (const :tag "1200" 5)
		 (const :tag "700" 6)
		 (const :tag "700B" 7)
		 (const :tag "700C" 8)))

(defconst rcirc-voirc--max-length 312)

(defun rcirc-voirc--encode (&optional delete)
  "Encode text in the buffer into the VoIRC encoding.
The resulting code is returned as a string.  If the optional argument
DELETE is non-nil, then delete the processed region from the buffer."
  (save-excursion
    (goto-char (point-min))
    (let ((value 0) (bits 0) res)
      (while (not (eobp))
	(when-let ((b (char-after)))
	  (cl-callf logior value (ash b bits))
	  (cl-incf bits 8)
	  (when (or (= (1+ (point)) (point-max))
		    (>= bits 13))
	    (let ((c (logand value #x1fff)))
	      (cl-callf ash value -13)
	      (cl-decf bits 13)
	      (push (+ (/ c 94) 33) res)
	      (push (+ (mod c 94) 33) res))))
	(forward-char))
      ;; FIXME: A byte can be dropped here, but the original
      ;; implementation does that as well.
      (when delete
	(delete-region (point-min) (point-max)))
      (concat (nreverse res)))))

(defun rcirc-voirc--decode (data)
  "Decode VOIRC encoded DATA into a string."
  (if (cl-oddp (length data)) ""
    (let ((i 0) (value 0) (bits 0) res)
      (while (< i (length data))
	(let ((tmp (+ (* (- (aref data i) 33) 94)
		      (- (aref data (1+ i)) 33))))
	  (cl-callf logior value (ash tmp bits))
	  (cl-incf bits 13)
	  (while (>= bits 8)
	    (push (logand value #xff) res)
	    (cl-callf ash value -8)
	    (cl-decf bits 8)))
	(cl-incf i 2))
      ;; TODO: There is a better way to construct a unibyte string
      ;; from a list of bytes, right?
      (cl-loop with str = (make-string (length res) 0)
	       for c in res
	       for i downfrom (1- (length res))
	       do (aset str i c)
	       finally return str))))

(defvar rcirc-voirc--process)
(defvar rcirc-voirc--target)
(declare-function rcirc-voirc--send-message ())
(let ((n 0))				;message counter
  (defun rcirc-voirc--send-message (&optional start end)
    "Encode and send the voice data between START and END.
If the optional START and END are omitted, they default to `point-min'
and `point-max' respectivly."
    (save-restriction
      (setq start (or start (point-min))
	    end (min (+ start rcirc-voirc--max-length)
		     (or end (point-max))))
      (narrow-to-region start end)
      (let ((msg (rcirc-voirc--encode t)))
	(rcirc-send-message
	 rcirc-voirc--process
	 rcirc-voirc--target
	 (format "Vo%c%c%c01]%s"
		 (if (/= (logand n 4) 0) ?I ?i)
		 (if (/= (logand n 2) 0) ?R ?r)
		 (if (/= (logand n 1) 0) ?C ?c)
		 msg))))
    (cl-incf n)))

(defun rcirc-voirc--recv-message (data)
  "Decode and play the sound in DATA."
  (let ((sound-file
	 (with-file-modes #o600
	   (make-temp-file "rcirc-voirc" nil ".c2" data))))
    (make-process
     :name "*rcirc-voirc-play*"
     :stderr
     (with-current-buffer
	 (get-buffer-create " *rcirc-voirc-out-err*")
       (erase-buffer)	;reset buffer
       (current-buffer))
     :coding 'no-conversion
     :sentinel
     (lambda (proc _status)		;clean up after ourselves
       (when (memq (process-status proc) '(exit signal))
	 (delete-file sound-file)))
     :command
     (list "ffplay" "-nodisp" "-autoexit"
	   "-b:a:0" (number-to-string rcirc-voirc-sample-rate)
	   "-f" "codec2" "-i" sound-file))))

(defun rcirc-voirc--record ()
  "Record audio, encode the data and send them."
  (with-temp-buffer
    (set-buffer-multibyte nil)
    (let* ((error-buffer
	    (with-current-buffer
		(get-buffer-create " *rcirc-voirc-in-err*")
	      (erase-buffer)	;reset buffer
	      (current-buffer)))
	   (ffmpeg
	    (make-process
	     :name "*rcirc-voirc-record*"
	     :buffer (current-buffer)
	     :stderr error-buffer
	     :sentinel #'ignore
	     :coding 'no-conversion
	     :command
	     (list "ffmpeg"
	       "-f" rcirc-voirc-source
	       "-i" rcirc-voirc-input
	       "-af" "afftdn"
	       "-mode" (number-to-string rcirc-voirc-codec2-mode)
	       "-r" (number-to-string rcirc-voirc-sample-rate)
	       "-f" "codec2" "-"))))

      ;; Wait for FFmpeg to finish
      (message "Press any key to stop recording...")
      (while (accept-process-output ffmpeg)
	(while (> (buffer-size) rcirc-voirc--max-length)
	  (rcirc-voirc--send-message))
	(when (input-pending-p)
	  (ignore (read-char))
	  (process-send-string ffmpeg "q")))
      (while (> (buffer-size) 0)
	(rcirc-voirc--send-message))
      
      ;; Check if FFmpeg terminated
      (if (memq (process-status ffmpeg) '(exit signal))
	  (if (/= (process-exit-status ffmpeg) 0)
	      (error "FFmpeg failed, see %S" (buffer-name error-buffer)))
	(error "FFmpeg did not terminate"))
      (delete-process ffmpeg))))

(defun rcirc-voirc-record ()
  "Start a voice recording targeted at the current channel."
  (interactive)
  (let ((rcirc-voirc--process (rcirc-buffer-process))
	(rcirc-voirc--target rcirc-target))
    (unless rcirc-voirc--process
      (user-error "No associated IRC process"))
    (unless rcirc-voirc--target
      (user-error "No target to send to"))
    (rcirc-voirc--record)))

(defvar rcirc-voirc-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "<f12>") #'rcirc-voirc-record)
    map))

(defun rcirc-voirc--process-message (process command sender args line)
  "Hook to check if LINE is a voice message.
The remaining arguments (PROCESS, COMMAND, SENDER, ARGS) are used to
check if the message should be played or not, depending on whether
`rcirc-voirc-mode' has been enabled or not."
  (let ((case-fold-search t))
    ;; We are more liberal here than the reference implementation, but
    ;; accepting anything that ends in a VoIRC message, instead of
    ;; messages that only consists of a VoIRC message.
    (when (and (string= command "PRIVMSG")
	       (let ((b (rcirc-target-buffer process sender command (car args) nil)))
		 (and b (buffer-local-value 'rcirc-voirc-mode b)))
	       (bound-and-true-p rcirc-voirc-mode)
	       (string-match (rx "voirc01]" (group (* nonl)) eol)
			line))
      (rcirc-voirc--recv-message
       (rcirc-voirc--decode
	(match-string 1 line))))))

(define-minor-mode rcirc-voirc-mode ()
  :lighter " VoIRC"
  (catch 'other-buffer
    (dolist (buf (buffer-list))
      (when (and (not (eq buf (current-buffer)))
		 (buffer-local-value 'rcirc-voirc-mode buf))
	(throw 'other-buffer nil)))
    ;; Remove the global hook if this is the last buffer with the
    ;; minor mode enabled.
    (remove-hook 'rcirc-receive-message-functions
		 #'rcirc-voirc--process-message))
  (when rcirc-voirc-mode
    (add-hook 'rcirc-receive-message-functions
	      #'rcirc-voirc--process-message)))

(provide 'rcirc-voirc)
;;; rcirc-voirc.el ends here