;;; thogai.el --- Stenotyping software -*- lexical-binding: t -*-

;; Stenotyping software for Emacs
;; Copyright (C) 2022 Arun Isaac
;;
;; Author: Arun Isaac <arunisaac@systemreboot.net>
;; Version: 0.1.0
;; Keywords: abbrev, convenience, hardware
;; Homepage: https://git.systemreboot.net/thogai
;; Package-Requires: ((emacs "27.1"))

;; This file is part of thogai.

;; thogai 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.

;; thogai 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 thogai.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; thogai is stenotyping software.  It interfaces with steno machines
;; using the Gemini protocol, and translates strokes using a steno
;; dictionary in the Plover dictionary format.
;;
;; Usage:
;;
;; Connect to your steno machine using the Gemini protocol with
;;
;; M-x thogai-connect
;; 
;; Chord away!

;;; Code:

(require 'map)
(require 'pcase)
(require 'seq)
(require 'subr-x)
(require 'term)

(defvar thogai-dictionary-files
  (list "~/.config/plover/main.json"
        "~/.config/plover/commands.json")
  "List of dictionary files in order of increasing precedence.

All files should be in the Plover dictionary format, and are read
and loaded into memory when `thogai-load-dictionaries' is run.")

(defvar thogai-user-dictionary-alist
  nil
  "Additional dictionary entries.

This is an association list specifying additional translations
not present in `thogai-dictionary-files'.  For example,

(setq thogai-user-dictionary-alist
      '((\"PER\" . \"perfect\")
        (\"THO/TKPWAOEU\" . \"thogai\")))")

(defvar thogai-dictionary
  (make-hash-table :test 'equal)
  "Hash table used as the steno dictionary by thogai.

This variable is loaded from files listed in
`thogai-dictionary-files' on running `thogai-load-dictionaries'.")

(defvar thogai-stroke-ring-size
  1000
  "Size of `thogai-stroke-ring'.

This is the number of past strokes thogai keeps track of.  Among
other things, it affects the number of strokes one can undo back
to.")

(defvar thogai-stroke-ring
  (make-ring thogai-stroke-ring-size)
  "Ring tracking all past strokes.")

(defvar thogai-attach-next
  nil
  "Flag indicating whether to attach the next translation.

If non-nil, the next part of the translation is attached without
a space, and the variable is reset to nil.")

(defvar thogai-glue
  nil
  "Flag indicating whether to glue the next translation.

If non-nil and the next part of the translation also starts with
a glue operator, it is attached without a space, and the variable
is reset to nil.")

(defvar thogai-capitalize-next-word
  nil
  "Flag indicating whether to capitalize the next word.

If non-nil, the first letter of the next word is capitalized and
the variable is reset to nil.")

(defvar thogai-uncapitalize-next-word
  nil
  "Flag indicating whether to uncapitalize the next word.

If non-nil, the first letter of the next word is uncapitalized
and the variable is reset to nil.")

(defun thogai-load-dictionaries ()
  "Load dictionary files in THOGAI-DICTIONARY-FILES."
  (interactive)
  ;; Reset hash table.
  (clrhash thogai-dictionary)
  (let ((thogai-dictionary-longest-key 0))
    (dolist (dictionary-file thogai-dictionary-files)
      (maphash (lambda (key value)
                 ;; Load key, value pair into hash table.
                 (puthash key value thogai-dictionary)
                 ;; Update length of longest key.
                 (setq thogai-dictionary-longest-key
                       (max thogai-dictionary-longest-key
                            (length (split-string key "/")))))
               ;; Parse JSON dictionary file.
               (with-temp-buffer
                 (insert-file-contents dictionary-file)
                 (json-parse-buffer))))
    ;; Enlarge `thogai-stroke-ring' if it is too small.
    (when (< (ring-size thogai-stroke-ring)
             thogai-dictionary-longest-key)
      (ring-resize thogai-stroke-ring thogai-dictionary-longest-key)))
  (message "Loaded %d dictionary entries"
           (hash-table-count thogai-dictionary)))

(defun thogai-lookup (stroke)
  "Lookup STROKE in dictionary.

STROKE is looked up in `thogai-user-dictionary-alist' and
`thogai-dictionary' with `thogai-user-dictionary-alist' having
higher precedence.  If STROKE is in neither, nil is returned."
  (or (map-elt thogai-user-dictionary-alist stroke)
      (map-elt thogai-dictionary stroke)))

(defun thogai-longest-match (state)
  "Return the longest sublist of STATE that maps to a stroke.

STATE is a list of strokes, oldest first.  STATE should typically
be the list of elements in `thogai-stroke-ring', or a subset
thereof."
  (if (thogai-lookup (string-join state "/"))
      state
    (pcase state
      (`(,_ . ,tail)
       (thogai-longest-match tail)))))

(defun thogai-delete (string)
  "Delete STRING before point, if it is present.

If STRING is not present before point, do nothing."
  (let ((start (- (point) (length string)))
        (end (point)))
    (when (and (>= start (point-min))
               (string= (buffer-substring start end)
                        string))
      (delete-region start end))))

(defun thogai-compose (&rest functions)
  "Return a composition of FUNCTIONS.

The last function in FUNCTIONS is applied first."
  (lambda (arg)
    (seq-reduce (lambda (result function)
                  (funcall function result))
                functions
                arg)))

(defun thogai-insert-space ()
  "Insert space at point if necessary.

Insert space at point unless at the beginning of a line or
`thogai-attach-next' is non-nil."
  (unless (or (= (line-beginning-position)
                 (point))
              thogai-attach-next)
    (insert " ")))

(defun thogai-insert-literal (literal-translation)
  "Insert LITERAL-TRANSLATION at point.

Insert LITERAL-TRANSLATION at point, respecting
`thogai-capitalize-next-word' and
`thogai-uncapitalize-next-word'."
  (insert (funcall (thogai-compose
                    ;; Capitalize first letter.
                    (if thogai-capitalize-next-word
                        (lambda (str)
                          (setq thogai-capitalize-next-word nil)
                          (concat (upcase (substring str 0 1))
                                  (substring str 1)))
                      'identity)
                    ;; Uncapitalize first letter.
                    (if thogai-uncapitalize-next-word
                        (lambda (str)
                          (setq thogai-uncapitalize-next-word nil)
                          (concat (downcase (substring str 0 1))
                                  (substring str 1)))
                      'identity))
                   literal-translation)))

(defun thogai-insert-translation (translation &optional subtranslation)
  "Insert TRANSLATION at point.

TRANSLATION is a string mapped to in a steno dictionary.  If
SUBTRANSLATION is non-nil, this is a recursive call.  External
callers should never pass non-nil SUBTRANSLATION."
  (pcase (save-match-data
           (string-match (rx string-start (or (one-or-more (not ?{))
                                              (sequence ?{ (one-or-more (not ?{)) ?})))
                         translation)
           (list (match-string 0 translation)
                 (substring translation (match-end 0))))
    (`(,translation ,rest-of-translation)
     (pcase translation
       ;; Attach operator
       ("{^}"
        (setq thogai-attach-next t))
       ;; Prefix
       ((pred (lambda (str)
                (string-suffix-p "^}" str)))
        (thogai-insert-literal
         (string-remove-prefix "{" (string-remove-suffix "^}" translation)))
        (setq thogai-attach-next t))
       ;; Glue operator
       ((pred (lambda (str)
                (and (string-prefix-p "{&" str)
                     (string-suffix-p "}" str))))
        (unless thogai-glue
          (thogai-insert-space))
        (thogai-insert-literal
         (string-remove-prefix "{&" (string-remove-suffix "}" translation)))
        (setq thogai-glue t))
       ;; Capitalize next word.
       ("{-|}"
        (setq thogai-capitalize-next-word t))
       ;; Capitalize previous word.
       ("{*-|}"
        (save-excursion
          (left-word)
          (upcase-region (point) (1+ (point)))))
       ;; Uncapitalize next word.
       ("{>}"
        (setq thogai-uncapitalize-next-word t))
       ;; Uncapitalize previous word.
       ("{*>}"
        (save-excursion
          (left-word)
          (downcase-region (point) (1+ (point)))))
       ;; Retroactively delete space.
       ("{*!}"
        (save-excursion
          (left-word)
          (delete-char -1)))
       ;; Simple literal translation
       (_
        (unless subtranslation
          (thogai-insert-space))
        ;; Reset `thogai-attach-next' and `thogai-glue'.
        (setq thogai-attach-next nil
              thogai-glue nil)
        (thogai-insert-literal translation)))
     ;; Recurse for rest of translation.
     (unless (string= rest-of-translation "")
       (thogai-insert-translation rest-of-translation t)))))

(defun thogai-reverse-strokes (strokes)
  "Reverse the effects of STROKES.

STROKES is a list of strokes, oldest first.  `thogai-stroke-ring'
is unaltered."
  (thogai-delete
   (with-temp-buffer
     (thogai-inject-strokes strokes (make-ring (length strokes)))
     (buffer-string))))

(defun thogai-inject-strokes (strokes &optional stroke-ring)
  "Inject STROKES into STROKE-RING.

Inject STROKES, a list of strokes, into STROKE-RING as though
they were really stroked on the steno machine.  If unspecified,
STROKE-RING is `thogai-stroke-ring'.  The first element of
STROKES is injected first."
  (let ((stroke-ring (or stroke-ring
                         thogai-stroke-ring)))
    ;; Inject strokes one by one.
    (dolist (stroke strokes)
      (ring-insert stroke-ring stroke)
      (thogai-insert-stroke stroke-ring))))

(defun thogai-insert-stroke (stroke-ring)
  "Translate the most recent stroke and insert it at point.

STROKE-RING is the ring representing the current state, and
should typically be `thogai-stroke-ring'."
  (if (string= (ring-ref stroke-ring 0) "*")
      ;; Special case to handle the undo operation
      (progn
        ;; Drop the "*" stroke from the state ring.
        (ring-remove stroke-ring 0)
        (let ((matched-strokes
               (or (thogai-longest-match (reverse (ring-elements stroke-ring)))
                   (list (ring-ref stroke-ring 0)))))
          ;; Reverse the previous group of strokes.
          (thogai-reverse-strokes matched-strokes)
          ;; Delete space before strokes unless we are at the
          ;; beginning of the line. Note that attached and glued
          ;; strokes do not emit spaces. So, we cannot mindlessly
          ;; delete a character without checking if it is a space.
          (unless (= (line-beginning-position)
                     (point))
            (thogai-delete " "))
          ;; Re-insert the previous group of strokes except for the
          ;; newest stroke.
          (pcase (reverse matched-strokes)
            (`(,_ . ,other-strokes)
             (thogai-inject-strokes (reverse other-strokes)
                                    (make-ring (length other-strokes))))))
        ;; Remove the newest stroke from the state ring.
        (ring-remove stroke-ring 0))
    (let ((matched-strokes
           (thogai-longest-match (reverse (ring-elements stroke-ring)))))
      ;; Delete translation for earlier strokes that are captured by
      ;; this translation. If no strokes were matched, skip this step.
      (unless (null matched-strokes)
        (thogai-reverse-strokes (butlast matched-strokes)))
      ;; Insert literal stroke if it is not in the dictionary. Else,
      ;; insert the actual translation.
      (if (null matched-strokes)
          (thogai-insert-translation (ring-ref stroke-ring 0))
        (thogai-insert-translation (thogai-lookup (string-join matched-strokes "/")))))))

(defun thogai-byte-to-bits (byte)
  "Convert BYTE to a list of 8 bits.

Each element of the returned list is a boolean, and the first
element is the most significant bit."
  (seq-map (lambda (i)
             (not (zerop (logand byte (lsh 1 i)))))
           (number-sequence 7 0 -1)))

(defun thogai-filter-mapn (function &rest sequences)
  "Map FUNCTION over SEQUENCES and return only non-nil results.

Map FUNCTION over all SEQUENCES using `seq-mapn', but return a
list of only the non-nil results."
  (seq-filter 'identity
              (apply 'seq-mapn function sequences)))

(defun thogai-mapcatn (function &rest sequences)
  "Map FUNCTION over SEQUENCES and concatenate the results.

Map FUNCTION over all SEQUENCES using `seq-mapn', and concatenate
the results into a list."
  (apply 'seq-concatenate 'list
         (apply 'seq-mapn function sequences)))

;; See
;; https://github.com/openstenoproject/plover/blob/master/plover/machine/geminipr.py
;; for protocol documentation.
(defun thogai-gemini-decode-stroke (bytes)
  "Decode stroke represented by BYTES from the Gemini protocol.

BYTES is a list of 6 bytes in the Gemini protocol."
  (let* ((keys '(("Fn" "#1" "#2" "#3" "#4" "#5" "#6")
                 ("S1-" "S2-" "T-" "K-" "P-" "W-" "H-")
                 ("R-" "A-" "O-" "*1" "*2" "res1" "res2")
                 ("pwr" "*3" "*4" "-E" "-U" "-F" "-R")
                 ("-P" "-B" "-L" "-G" "-T" "-S" "-D")
                 ("#7" "#8" "#9" "#A" "#B" "#C" "-Z")))
         (pressed-keys
          (thogai-mapcatn (lambda (byte keys)
                            (thogai-filter-mapn (lambda (selectp key)
                                                  (and selectp key))
                                                (seq-drop (thogai-byte-to-bits byte)
                                                          1)
                                                keys))
                          bytes
                          keys)))
    ;; NOTE: We recognize only a subset of keys supported by the
    ;; Gemini protocol. For example, we recognize only a single S, not
    ;; S1 and S2.
    (let ((left (seq-mapcat (lambda (key)
                              (string-trim-right key (rx (one-or-more (or ?1 ?2 ?-)))))
                            (seq-filter (lambda (key)
                                          (or (string= key "#1")
                                              (and (not (member key (list "A-" "O-")))
                                                   (string-suffix-p "-" key))))
                                        pressed-keys)
                            'string))
          (vowel-or-star (seq-mapcat (lambda (key)
                                       (string-trim key "-" (rx (or ?- ?1))))
                                     (seq-filter (lambda (key)
                                                   (member key (list "A-" "O-" "*1" "-E" "-U")))
                                                 pressed-keys)
                                     'string))
          (right (seq-mapcat (lambda (key)
                               (string-remove-prefix "-" key))
                             (seq-filter (lambda (key)
                                           (and (not (member key (list "-E" "-U")))
                                                (string-prefix-p "-" key)))
                                         pressed-keys)
                             'string)))
      (concat left
              vowel-or-star
              ;; Add hyphen if there is no vowel but there are
              ;; right-side keys.
              (if (and (string= vowel-or-star "")
                       (not (string= right "")))
                  "-"
                "")
              right))))

(let ((bytes nil))
  (defun thogai-gemini-protocol-filter (process output)
    "Process filter for the Gemini serial protocol."
    (let ((bytes-per-stroke 6))
      (dolist (byte (string-to-list output))
        (push byte bytes)
        ;; The Gemini protocol represents each stroke by 6
        ;; bytes. Decode stroke once 6 bytes are received.
        (when (= (length bytes) bytes-per-stroke)
          (let ((stroke (thogai-gemini-decode-stroke (reverse bytes))))
            ;; Log to paper tape.
            (with-current-buffer (process-buffer process)
              (insert stroke)
              (insert "\n"))
            ;; Insert into stroke ring, and process translation.
            (ring-insert thogai-stroke-ring stroke)
            (thogai-insert-stroke thogai-stroke-ring))
          (setq bytes nil))))))

(defun thogai-connect (port speed)
  "Connect to steno machine at serial PORT with SPEED."
  (interactive (list (serial-read-name)
                     (serial-read-speed)))
  (make-serial-process :port port
                       :buffer "*thogai-paper-tape*"
                       :speed speed
                       :filter 'thogai-gemini-protocol-filter)
  (message "Connected to steno machine at %s via the Gemini protocol"
           port))

(provide 'thogai)

;;; thogai.el ends here