diff --git a/conlanging-graphviz.el b/conlanging-graphviz.el new file mode 100644 index 0000000..6369fc1 --- /dev/null +++ b/conlanging-graphviz.el @@ -0,0 +1,121 @@ +;;; conlanging-graphviz.el --- Graphviz utilities for conlanging -*- lexical-binding: t -*- + +;; Author: Lucien Cartier-Tilet +;; Maintainer: Lucien Cartier-Tilet +;; Version: 0.1.0 +;; Package-Requires: ((emacs "26.1")) +;; Homepage: https://labs.phundrak.com/phundrak/conlanging.el +;; Keywords: convenience + + +;; This file is not part of GNU Emacs + +;; 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 . + + +;;; Code: +(require 'ox) + +(defun conlanging-graphviz--node-link (node parent) + "Create a graphviz node between NODE and PARENT. +Both NODE and PARENT must be the name and not the label of the +node." + (format "\"%s\"--\"%s\";" parent node)) + +(defun conlanging-graphviz--node (name label) + "Create a node named NAME with the label LABEL." + (format "\"%s\"[label=\"%s\"];" name label)) + +(defun conlanging-graphviz--str-add-id (str) + "Append a unique id to STR." + (concat str "-" (org-id-time-to-b36))) + +;;;###autoload +(defun conlanging-graphviz-list-to-graphviz (list &optional previous-node-name) + "Convert LIST into a graphviz tree. +LIST must be in the form of + + (\"label\" + child1 + child2 + ...) + +with each child being either another list in the same for or a +string which is then a leaf. + +PREVIOUS-NODE-NAME is the parent node of the current tree being +formed. If it is nil, then it means the current tree is the root +tree itself." + (cond + ((listp list) ;; it's a node! + (let* ((tree-root-p (null previous-node-name)) + (node-label (car list)) + (node-name (conlanging-graphviz--str-add-id node-label)) + (graph-str (if tree-root-p + "graph{graph[dpi=300,bgcolor=\"transparent\"];node[shape=plaintext];" + ""))) + (setq graph-str + (concat graph-str + (conlanging-graphviz--node node-name node-label) + (if (not tree-root-p) + (conlanging-graphviz--node-link node-name previous-node-name) + ""))) + (dolist (child (cdr list) graph-str) + (setf graph-str (concat graph-str + (conlanging-graphviz-list-to-graphviz child node-name)))) + (concat graph-str (if tree-root-p "}" "")))) + ((stringp list) ;; it's a leaf! + (let ((name (conlanging-graphviz--str-add-id list))) + (concat (conlanging-graphviz--node name list) + (conlanging-graphviz--node-link name previous-node-name)))) + (t (error "Cannot handle something that isn't a string or a list!")))) + +;;;###autoload +(cl-defun conlanging-graphviz-feature-tree (node &key ((:previous previous-node-name) nil) (label "")) + "Create a feature tree from NODE. + +LABEL is the label of the root node. + +PREVIOUS is for internal use. It refers to the parent node of +NODE if NODE is a subtree of the root tree." + (cond + ((stringp node) ;; it's a leaf! + (let ((name (conlanging-graphviz--str-add-id node))) + (concat (conlanging-graphviz--node name node) + (conlanging-graphviz--node-link name previous-node-name)))) + ((listp node) ;; it's a node! + (let* ((tree-root-p (null previous-node-name)) + (root-name (or previous-node-name + (conlanging-graphviz--str-add-id label))) + (positive-node-label (concat "+" (car node))) + (positive-node-name (conlanging-graphviz--str-add-id positive-node-label)) + (negative-node-label (concat "-" (car node))) + (negative-node-name (conlanging-graphviz--str-add-id negative-node-label)) + (graph-header (if tree-root-p + (concat "graph{graph[dpi=300,bgcolor=\"transparent\"];node[shape=plaintext];" + (conlanging-graphviz--node root-name label)) + ""))) + ;; create positive label + (concat graph-header + (conlanging-graphviz--node positive-node-name positive-node-label) + (conlanging-graphviz--node-link positive-node-name root-name) + (conlanging-graphviz-feature-tree (nth 1 node) :previous positive-node-name) + (conlanging-graphviz--node negative-node-name negative-node-label) + (conlanging-graphviz--node-link negative-node-name root-name) + (conlanging-graphviz-feature-tree (nth 2 node) :previous negative-node-name) + (if tree-root-p "}" "")))))) + +(provide 'conlanging-graphviz) + +;;; conlanging-graphviz.el ends here diff --git a/conlanging.el b/conlanging.el index 39b8b4f..be9f989 100644 --- a/conlanging.el +++ b/conlanging.el @@ -37,181 +37,13 @@ ;;; Code: -(require 'org) -(require 'ox) (require 'seq) -(require 'eieio) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ; Tree generation ; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun conlanging--declare-node (t-node-text t-node-generation) - "Declares a node in the graphviz source code. - -The node’s identifier will be `T-NODE-GENERATION', and it will -bear the label `T-NODE-TEXT'." - (format "%d[label=\"%s\"];" - t-node-generation - t-node-text)) - -(defun conlanging--declare-node-for-list (t-name t-label) - (format "\"%s\"[label=\"%s\"];" - t-name - t-label)) - -;;;###autoload -(defun conlanging-list-to-graphviz (t-list &optional t-previous-node) - (cond - ((null t-previous-node) - (let* ((list (car t-list)) - (label (car list)) - (label-name (concat label "-" (org-id-time-to-b36)))) - (concat "graph{graph[dpi=300,bgcolor=\"transparent\"];node[shape=plaintext];" - (conlanging--declare-node-for-list label-name label) - (conlanging-list-to-graphviz (cdadr list) label-name) - "}"))) - ((null t-list) "") - ((listp t-list) - (let* ((graph-str "")) - (dolist (elem t-list graph-str) - (let* ((label (car elem)) - (label-name (concat label "-" (org-id-time-to-b36)))) - (setf graph-str - (format "%s%s\"%s\"--\"%s\";%s" - graph-str - (conlanging--declare-node-for-list label-name label) - t-previous-node - label-name - (conlanging-list-to-graphviz (cdadr elem) - label-name))))))))) - - -;;;###autoload -(defun conlanging-tree-to-dot (t-tree &optional t-current-generation t-previous-generation) - "Translate an Elisp tree into a graphviz tree. - -Translate `T-TREE' with any number of children per node -to a corresponding graphviz file that can be executed from dot. - -`T-CURRENT-GENERATION' represents the generation number, -incremented when changing from a node to another node from the -same generation, multiplied by 10 when going from a node to one -of its children. For internal use only. - -`T-PREVIOUS-GENERATION' is the generation number from previous -named node. For internal use only." - (cond - ((null t-previous-generation) ;; first call - (concat "graph{graph[dpi=300];node[shape=plaintext];graph[bgcolor=\"transparent\"];" - (conlanging--declare-node (car t-tree) 0) - (conlanging-tree-to-dot (cdr t-tree) 1 0) - "}")) - ((null t-tree) "") ;; last call in this branch - ((atom (car t-tree)) ;; '("text" () () ()) manage the label - (concat (conlanging--declare-node (car t-tree) - t-current-generation) - ;; make link - (concat (number-to-string t-previous-generation) " -- " - (number-to-string t-current-generation) ";") - (conlanging-tree-to-dot (cdr t-tree) - (+ 1 - (* 10 t-current-generation)) - t-current-generation))) - ((listp (car t-tree)) ;; '(() () ()) manage the branches - (concat (conlanging-tree-to-dot (car t-tree) ;; child of current node - t-current-generation - t-previous-generation) - (conlanging-tree-to-dot (cdr t-tree) - (+ 1 t-current-generation) - t-previous-generation))))) +(require 'conlanging-graphviz) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Text transformation ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ; Mattér ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ; dead conlang ;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar conlanging--matter-latin-to-runes '((", *" . "᛬") - ("\\. *" . "᛭") - (" +" . "᛫") - ("ċ" . "ᛇ") - ("ch" . "ᛇ") - ("ae" . "ᚫ") - ("æ" . "ᚫ") - ("dh" . "ᛋ") - ("z" . "ᛋ") - ("ð" . "ᛋ") - ("th" . "ᚦ") - ("s" . "ᚦ") - ("þ" . "ᚦ") - ("w" . "ᚹ") - ("ƿ" . "ᚹ") - ("g" . "ᚷ") - ("ᵹ" . "ᚷ") - ("ea" . "ᛠ") - ("f" . "ᚠ") - ("u" . "ᚢ") - ("o" . "ᚩ") - ("r" . "ᚱ") - ("c" . "ᚳ") - ("h" . "ᚻ") - ("n" . "ᚾ") - ("i" . "ᛁ") - ("j" . "ᛄ") - ("p" . "ᛈ") - ("v" . "ᛝ") - ("t" . "ᛏ") - ("b" . "ᛒ") - ("e" . "ᛖ") - ("m" . "ᛗ") - ("l" . "ᛚ") - ("d" . "ᛞ") - ("é" . "ᛟ") - ("a" . "ᚪ") - ("y" . "ᚣ")) - "Equivalence between the Mattér Latin and Runic scripts. - -The first element of a pair is the Latin script orthography, the -second is the Runic equivalent.") - -(defvar conlanging--matter-latin-to-native '((" +" . " ") - ("ch" . "ċ") - ("ae" . "æ") - ("th" . "þ") - ("s" . "þ") - ("dh" . "ð") - ("z" . "ð") - ("w" . "ƿ") - ("j" . "i")) - "Equivalence between Mattér orthography and transliterated Mattér. - -The first element of a pair is the transliterated Latin script -orthography, the second is the native Latin script equivalent.") - -(defvar conlanging--matter-latin-to-latex '((", *" . ":") - ("\\. *" . "*") - (" +" . ".") - ("ch" . "I") - ("ċ" . "I") - ("ae" . "æ") - ("ea" . "\\\\ea") - ("ƿ" . "w") - ("dh" . "s") - ("z" . "s") - ("ð" . "s") - ("th" . "þ") - ("s" . "þ") - ("v" . "\\\\ng") - ("é " . "\\\\oe")) - "Mattér orthography to LaTeX code. - -Equivalence between the Mattér orthography in the Latin script -and the LaTeX code for the Runic script. The first element of a -pair is the Latin script orthography, the second is the Runic -LaTeX code equivalent.") - ; Eittlandic ;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar conlanging--eittlandic-latin-to-latex '((", *\\|\\. *" . "\\\\tripledot") @@ -260,10 +92,7 @@ second is the Runic LaTeX code equivalent.") The first element of a pair is the Latin script orthography, the second is the Runic equivalent.") -(defvar conlanging-language-list `((matter-runes . ,conlanging--matter-latin-to-runes) - (matter-latin . ,conlanging--matter-latin-to-native) - (matter-latex . ,conlanging--matter-latin-to-latex) - (eittlandic-runes . ,conlanging--eittlandic-latin-to-runes) +(defvar conlanging-language-list `((eittlandic-runes . ,conlanging--eittlandic-latin-to-runes) (eittlandic-latex . ,conlanging--eittlandic-latin-to-latex))) (defun conlanging--translate (text table) @@ -311,92 +140,6 @@ LANGUAGE must be one of the following values: ('matter 'matter-runes) (otherwise (error "Option \"%s\" not supported" otherwise)))))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ; Text to phonetics ; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defclass conlanging--proto-nyqy-phoneme nil - ((grapheme :initarg :grapheme - :type string - :documentation "The way the phoneme is written.") - (is-consonant :initarg :is-consonant - :initform nil - :type boolean) - (is-dorsal :initarg :is-dorsal - :initform nil - :type boolean) - (phoneme :initarg :phoneme - :type string - :documentation "Default pronunciation.") - (alt-phoneme :initarg :alt-phoneme - :initform "" - :type string - :documentation "Alternative pronunciation. For consonants only.")) - "Representation of a Proto-Ñyqy phoneme.") - -(defvar conlanging--proto-nyqy-phonetics - `(,(conlanging--proto-nyqy-phoneme :grapheme "q" :is-consonant t :is-dorsal t :phoneme "q" :alt-phoneme "ħ") - ,(conlanging--proto-nyqy-phoneme :grapheme "g" :is-consonant t :is-dorsal t :phoneme "ɢ" :alt-phoneme "ʢ") - ,(conlanging--proto-nyqy-phoneme :grapheme "ñ" :is-consonant t :is-dorsal t :phoneme "ɴ" :alt-phoneme "m") - ,(conlanging--proto-nyqy-phoneme :grapheme "c" :is-consonant t :is-dorsal t :phoneme "c" :alt-phoneme "ɬ") - ,(conlanging--proto-nyqy-phoneme :grapheme "j" :is-consonant t :is-dorsal t :phoneme "ɟ" :alt-phoneme "ɮ") - ,(conlanging--proto-nyqy-phoneme :grapheme "w" :is-consonant t :is-dorsal t :phoneme "w" :alt-phoneme "l") - ,(conlanging--proto-nyqy-phoneme :grapheme "p" :is-consonant t :phoneme "χ" :alt-phoneme "p") - ,(conlanging--proto-nyqy-phoneme :grapheme "b" :is-consonant t :phoneme "ʁ" :alt-phoneme "b") - ,(conlanging--proto-nyqy-phoneme :grapheme "m" :is-consonant t :phoneme "ʀ" :alt-phoneme "m") - ,(conlanging--proto-nyqy-phoneme :grapheme "n" :is-consonant t :phoneme "j" :alt-phoneme "n") - ,(conlanging--proto-nyqy-phoneme :grapheme "s" :is-consonant t :phoneme "x" :alt-phoneme "s") - ,(conlanging--proto-nyqy-phoneme :grapheme "z" :is-consonant t :phoneme "ɣ" :alt-phoneme "z") - ,(conlanging--proto-nyqy-phoneme :grapheme "y" :phoneme "y") - ,(conlanging--proto-nyqy-phoneme :grapheme "ú" :phoneme "u") - ,(conlanging--proto-nyqy-phoneme :grapheme "i" :phoneme "ɪ") - ,(conlanging--proto-nyqy-phoneme :grapheme "u" :phoneme "ʊ") - ,(conlanging--proto-nyqy-phoneme :grapheme "ø" :phoneme "ø") - ,(conlanging--proto-nyqy-phoneme :grapheme "œ" :phoneme "ɤ") - ,(conlanging--proto-nyqy-phoneme :grapheme "e" :phoneme "ɛ") - ,(conlanging--proto-nyqy-phoneme :grapheme "o" :phoneme "ɔ") - ,(conlanging--proto-nyqy-phoneme :grapheme " " :phoneme " ") - ,(conlanging--proto-nyqy-phoneme :grapheme "," :phoneme " ") - ,(conlanging--proto-nyqy-phoneme :grapheme ";" :phoneme " ") - ,(conlanging--proto-nyqy-phoneme :grapheme "." :phoneme " ")) - "List of Ñyqy characters and their phonetics equivalent. -See `conlanging--proto-nyqy-phoneme'.") - -;;;###autoload -(defun conlanging-proto-nyqy-to-phonetics (text) - "Return the phonetic equivalent of Proto-Ñyqy TEXT." - (let ((text (split-string (downcase text) "" t)) - (phonetics "") - (dorsal 'undefined)) - (dolist (grapheme text) - (let* ((cur-phoneme (seq-find (lambda (elem) - (equal (oref elem :grapheme) - grapheme)) - conlanging--proto-nyqy-phonetics))) - (when cur-phoneme - (if (oref cur-phoneme :is-consonant) - (progn - (when (eq dorsal 'undefined) - (setq dorsal (oref cur-phoneme :is-dorsal))) - (setq phonetics (concat phonetics - (if dorsal - (oref cur-phoneme :phoneme) - (oref cur-phoneme :alt-phoneme)))) - (setq dorsal (not dorsal))) - (setq phonetics (concat phonetics (oref cur-phoneme :phoneme))))))) - phonetics)) - -;;;###autoload -(defun conlanging-proto-nyqy-to-org (text) - "Return phonetic equivalent of TEXT for `org-mode' LaTeX and HTML exports. -Text is formatted as either LaTeX code or HTML code for their respective exports." - (let ((phonetics (conlanging-proto-nyqy-to-phonetics text))) - (format (concat "@@html:%s/%s/@@" - "@@latex:\\textit{%s} (/%s/)@@") - text - phonetics - text - phonetics))) - (provide 'conlanging) ;;; conlanging.el ends here