Initial commit

1 files changed, 425 insertions, 0 deletions

diff --git a/thogai.el b/thogai.el
new file mode 100644
index 0000000..7933ed1
--- /dev/null
+++ b/thogai.el
@@ -0,0 +1,425 @@
+;;; 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-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-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)))
+        (insert (string-remove-prefix "{" (string-remove-suffix "^}" translation)))
+        (setq thogai-attach-next 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
+       (_
+        ;; Insert a space unless at the beginning of line.
+        (unless (or subtranslation
+                    (= (line-beginning-position)
+                       (point))
+                    thogai-attach-next)
+          (insert " "))
+        ;; Reset `thogai-attach-next'.
+        (setq thogai-attach-next nil)
+        (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))
+                         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.
+          (unless (= (line-beginning-position)
+                     (point))
+            (delete-char -1))
+          ;; 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