feat: cleanup, update, improve, and split
This commit splits graphviz-related functions into its own file, conlanging-graphviz.el. It also updates these functions since org lists through noweb no longer work like they used to. Instead, going back to good old lisp lists, this commit significantly reduces the amount of code needed. This is the update and split part. This commit also removes a lot of old code that is no longer necessary since the removal of old documents for conlanging, rendering these functions obsolete. This is the cleanup part. Lastly, this commit adds the new function conlanging-graphviz-feature-tree which is able to generate a feature tree from a much more compact Lisp list than what conlang-graphviz-list-to-graphviz needs.
This commit is contained in:
parent
02d8717f18
commit
f20fb14f8e
GPG Key ID:
BD7789E705CB8DCA
|
|
@ -0,0 +1,121 @@
|
|||
;;; conlanging-graphviz.el --- Graphviz utilities for conlanging -*- lexical-binding: t -*-
|
||||
|
||||
;; Author: Lucien Cartier-Tilet <lucien@phundrak.com>
|
||||
;; Maintainer: Lucien Cartier-Tilet <lucien@phundrak.com>
|
||||
;; 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 <https://www.gnu.org/licenses/>.
|
||||
|
||||
|
||||
;;; 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
|
||||
261
conlanging.el
261
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:<span class=\"tooltip\"><i>%s</i><span class=\"tooltiptext\">/%s/</span></span>@@"
|
||||
"@@latex:\\textit{%s} (/%s/)@@")
|
||||
text
|
||||
phonetics
|
||||
text
|
||||
phonetics)))
|
||||
|
||||
(provide 'conlanging)
|
||||
|
||||
;;; conlanging.el ends here
|
||||
|
|
|
|||
Loading…
Reference in New Issue