conlanging.el/conlanging.el

403 lines
20 KiB
EmacsLisp
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; conlanging.el --- Helper functions for conlanging -*- lexical-binding: t -*-
;; Author: Lucien Cartier-Tilet
;; Maintainer: Lucien Cartier-Tilet
;; Version: 0.1.0
;; Package-Requires: ((emacs "24") (org "9") (eieio "1"))
;; Homepage: https://labs.phundrak.com/phundrak/conlanging.el
;; 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/>.
;;; Commentary:
;; This package is not made in order to be used by a lot of people.
;; Actually, it is made only for me. As such, there is no chance to
;; find it on any ELPA or MELPA.
;;
;; Functions and variables in this package are just helpers for myself
;; in order to write more easily the documentation on my conlangs.
;; This includes stuff such as automatic generation of text in
;; non-latin scripts or LaTeX-specific text from transliterated text,
;; graphviz trees for some stuff like syntax and feature trees, and
;; finally functions for creating automatic phonetics of a language a
;; tad complex when it comes to its pronunciation.
;;; 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 nodes 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)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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")
(" +" . ":")
("hv" . "x")
("í" . "i")
("é" . "\\\\e")
("ę\\" . "æ")
("ý" . "y")
("œ" . "ø")
("ú" . "u")
("ó" . "o")
("á\\" . "a")
("j" . "i"))
"Eittlandic Latin script to LaTeX code.
The first element of a pair is the Latin script orthography, the
second is the Runic LaTeX code equivalent.")
(defvar conlanging--eittlandic-latin-to-runes '((", *\\|\\. *" . "")
(" +\\|:" . "")
("hv" . "")
("i\\\\|j" . "")
("é" . "")
("e\\\\" . "")
("y\\" . "")
("ø\\" . "")
("u\\\\|v\\|w" . "")
("o\\" . "")
("a\\\\" . "")
("p" . "")
("b" . "")
("f" . "")
("t" . "")
("d" . "")
("þ" . "")
("ð" . "")
("s" . "")
("k" . "")
("g" . "")
("h" . "")
("m" . "")
("n" . "")
("r" . "")
("l" . ""))
"Eittlandic latin orthography to runes.
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)
(eittlandic-latex . ,conlanging--eittlandic-latin-to-latex)))
(defun conlanging--translate (text table)
"Translate TEXT through its correspondance TABLE."
(let ((rune-table (cdr (assoc table conlanging-language-list))))
(dolist (elem rune-table text)
(setq text (replace-regexp-in-string (car elem) (cdr elem) text)))))
(defun conlanging--replace-region-by-translation (table)
"Replace region with its translation through TABLE.
See `conlanging--translate'."
(interactive)
(let* ((beg (region-beginning))
(end (region-end))
(region-str (buffer-substring-no-properties beg end)))
(delete-region beg end)
(goto-char beg)
(insert (conlanging--translate region-str table))))
;;;###autoload
(defun conlanging-language-to-script (text language)
"Transform TEXT or current word or region in LANGUAGE to its native script.
LANGUAGE can be one of the values found in `conlanging-language-list'."
(interactive)
(let* ((table (alist-get language conlanging-language-list)))
(conlanging--translate text table)))
;;;###autoload
(defun conlanging-to-org-runes (text language)
"Translate TEXT from LANGUAGE to LaTeX runes equivalent for org exports.
LANGUAGE must be one of the following values:
- `matter'
- `eittlandic'"
(interactive)
(if (org-export-derived-backend-p org-export-current-backend 'latex)
(format "\\textarm{%s}" (conlanging--translate text
(pcase language
('eittlandic 'eittlandic-latex)
('matter 'matter-latex)
(otherwise (error "Option \"%s\" not supported" otherwise)))))
(conlanging--translate text
(pcase language
('eittlandic 'eittlandic-runes)
('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