zzkt/i-ching
1
0
Fork 0
Code Issues 3 Pull requests Activity Actions

䷧ Deliverance

Browse source 
When the operation is completed, a return to stability brings good fortune.
This commit is contained in:
nik gaffney 2021-01-18 18:01:53 +01:00
parent d830650704
commit c1391edcda
1 changed files with 67 additions and 67 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

134
i-ching.el
View file

@ -536,13 +536,13 @@ c.f. ‘The Superior man’ (Legge, Wilhem), ‘Noble young one’ (Hatcher), 't
(let* ((hexagrams i-ching-hexagram-summary) (let* ((hexagrams i-ching-hexagram-summary)
(selection (buffer-substring point mark)) (selection (buffer-substring point mark))
(hexagram (hexagram
(nth 4 (alist-get (nth 4 (alist-get
(i-ching-hexagram-to-number selection) (i-ching-hexagram-to-number selection)
hexagrams)))) hexagrams))))
(message "%s" (if hexagram (message "%s" (if hexagram
(capitalize (seq-drop hexagram 13)) (capitalize (seq-drop hexagram 13))
"Not a hexagram"))) "Not a hexagram")))
(message "Nothing selected"))) (message "Nothing selected")))
;;;;; ; ; ; ; ;;;;; ; ; ; ;
@ -561,16 +561,16 @@ Depending on the context and circumstance some methods may be more suitable.
see: `i-ching-divination-method' & `i-ching-randomness-source' for details." see: `i-ching-divination-method' & `i-ching-randomness-source' for details."
(interactive) (interactive)
(let ((method-function (let ((method-function
(pcase method (pcase method
;; the casting method should return a hexagram (or changing hexagram) ;; the casting method should return a hexagram (or changing hexagram)
('3-coins #'i-ching--three-coins) ('3-coins #'i-ching--three-coins)
('yarrow-stalks #'i-ching--yarrow-stalks) ('yarrow-stalks #'i-ching--yarrow-stalks)
('6-bit #'i-ching--random-number) ('6-bit #'i-ching--random-number)
('4-coins (message "unimplemented")) ('4-coins (message "unimplemented"))
('bagua (message "unimplemented")) ('bagua (message "unimplemented"))
('cheezburger (message "LOL")) ('cheezburger (message "LOL"))
(_ (_
#'i-ching--random-number)))) #'i-ching--random-number))))
(when method-function (when method-function
(let* ((line-1 (funcall method-function)) (let* ((line-1 (funcall method-function))
(line-2 (funcall method-function)) (line-2 (funcall method-function))
@ -614,9 +614,9 @@ see: `i-ching-divination-method' & `i-ching-randomness-source' for details."
;; the two hexagrams the same if there are no changing lines ;; the two hexagrams the same if there are no changing lines
(if (eql hexagram hexagram-changing) (if (eql hexagram hexagram-changing)
(i-ching-binary-to-hexagram hexagram) (i-ching-binary-to-hexagram hexagram)
(format "%s→%s" (format "%s→%s"
(i-ching-binary-to-hexagram hexagram) (i-ching-binary-to-hexagram hexagram)
(i-ching-binary-to-hexagram hexagram-changing)))))))) (i-ching-binary-to-hexagram hexagram-changing))))))))
;;;###autoload ;;;###autoload
@ -626,7 +626,7 @@ see: `i-ching-divination-method' & `i-ching-randomness-source' for details."
(insert (insert
(if number (if number
(i-ching-number-to-hexagram number) (i-ching-number-to-hexagram number)
(i-ching-cast)))) (i-ching-cast))))
;;;###autoload ;;;###autoload
(defun i-ching-insert-hexagram-and-name (&optional number) (defun i-ching-insert-hexagram-and-name (&optional number)
@ -649,15 +649,15 @@ see: `i-ching-divination-method' & `i-ching-randomness-source' for details."
(when (not source) (setq source i-ching-randomness-source)) (when (not source) (setq source i-ching-randomness-source))
(message "using: %s" source) (message "using: %s" source)
(pcase source (pcase source
('quantum (pcase n ('quantum (pcase n
(64 (i-ching-q64)) (64 (i-ching-q64))
(_ (/ (i-ching-q64) (/ 64 n))))) (_ (/ (i-ching-q64) (/ 64 n)))))
('atmospheric (pcase n ('atmospheric (pcase n
(64 (i-ching-r64)) (64 (i-ching-r64))
(_ (/ (i-ching-r64) (/ 64 n))))) (_ (/ (i-ching-r64) (/ 64 n)))))
('pseudo (+ 1 (random n))) ('pseudo (+ 1 (random n)))
(_ (_
(+ 1 (random n))))) (+ 1 (random n)))))
(defun i-ching-q64 () (defun i-ching-q64 ()
@ -665,16 +665,16 @@ see: `i-ching-divination-method' & `i-ching-randomness-source' for details."
Provided by ANU QRNG via https://qrng.anu.edu.au/" Provided by ANU QRNG via https://qrng.anu.edu.au/"
(let ((numeric 0)) (let ((numeric 0))
(request (request
"https://qrng.anu.edu.au/API/jsonI.php?length=1&type=hex16&size=1" "https://qrng.anu.edu.au/API/jsonI.php?length=1&type=hex16&size=1"
:sync t :sync t
:parser 'json-read :parser 'json-read
:success (cl-function :success (cl-function
(lambda (&key data &allow-other-keys) (lambda (&key data &allow-other-keys)
(setq (setq
numeric numeric
(/ (string-to-number (/ (string-to-number
(elt (alist-get 'data data) 0) 16) (elt (alist-get 'data data) 0) 16)
4))))) 4)))))
numeric)) numeric))
@ -683,12 +683,12 @@ Provided by ANU QRNG via https://qrng.anu.edu.au/"
Provided by Randomness and Integrity Services Ltd. via https://www.random.org/" Provided by Randomness and Integrity Services Ltd. via https://www.random.org/"
(let ((numeric 0)) (let ((numeric 0))
(request (request
"https://www.random.org/integers/?num=1&min=1&max=64&col=1&base=10&format=plain&rnd=new" "https://www.random.org/integers/?num=1&min=1&max=64&col=1&base=10&format=plain&rnd=new"
:sync t :sync t
;; :parser 'json-read ;; :parser 'json-read
:success (cl-function :success (cl-function
(lambda (&key data &allow-other-keys) (lambda (&key data &allow-other-keys)
(setf numeric (string-to-number data))))) (setf numeric (string-to-number data)))))
numeric)) numeric))
@ -709,9 +709,9 @@ Provided by Randomness and Integrity Services Ltd. via https://www.random.org/"
(defun i-ching--random-number () (defun i-ching--random-number ()
"Random line selection (unchanging)..." "Random line selection (unchanging)..."
(pcase (i-ching-random 2) (pcase (i-ching-random 2)
(1 '(1 1)) ;; yang (1 '(1 1)) ;; yang
(2 '(0 0)) ;; yin (2 '(0 0)) ;; yin
)) ))
(defun i-ching--coin-toss () (defun i-ching--coin-toss ()
"Simulate tossing a coin where H=2 and T=3." "Simulate tossing a coin where H=2 and T=3."
@ -746,7 +746,7 @@ Provided by Randomness and Integrity Services Ltd. via https://www.random.org/"
(dotimes (_ yarrow-stalks) (dotimes (_ yarrow-stalks)
(if (= 1 (i-ching-random 2)) (if (= 1 (i-ching-random 2))
(setq east (1+ east)) (setq east (1+ east))
(setq west (1+ west)))) (setq west (1+ west))))
;; One stalk is taken from the east bundle and placed between the fingers of the left hand ;; One stalk is taken from the east bundle and placed between the fingers of the left hand
(setq east (1- east)) (setq east (1- east))
(setq left (1+ left)) (setq left (1+ left))
@ -770,7 +770,7 @@ Provided by Randomness and Integrity Services Ltd. via https://www.random.org/"
(dotimes (_ yarrow-stalks) (dotimes (_ yarrow-stalks)
(if (= 1 (i-ching-random 2)) (if (= 1 (i-ching-random 2))
(setq east (1+ east)) (setq east (1+ east))
(setq west (1+ west)))) (setq west (1+ west))))
;; One stalk is taken from the east bundle and placed between the fingers of the left hand ;; One stalk is taken from the east bundle and placed between the fingers of the left hand
(setq east (1- east)) (setq east (1- east))
(setq left (1+ left)) (setq left (1+ left))
@ -787,7 +787,7 @@ Provided by Randomness and Integrity Services Ltd. via https://www.random.org/"
;; eight stalks results in the value of 2, four stalks results in the value of 3 ;; eight stalks results in the value of 2, four stalks results in the value of 3
(if (= 8 left) (if (= 8 left)
(setq result (+ result 2)) (setq result (+ result 2))
(setq result (+ result 3))) (setq result (+ result 3)))
;; These stalks are set aside and the remaining bundle of 32, 36 or 40 stalks is divided ;; These stalks are set aside and the remaining bundle of 32, 36 or 40 stalks is divided
;; and counted out in the same manner for a third operation ;; and counted out in the same manner for a third operation
@ -797,7 +797,7 @@ Provided by Randomness and Integrity Services Ltd. via https://www.random.org/"
(dotimes (_ yarrow-stalks) (dotimes (_ yarrow-stalks)
(if (= 1 (i-ching-random 2)) (if (= 1 (i-ching-random 2))
(setq east (1+ east)) (setq east (1+ east))
(setq west (1+ west)))) (setq west (1+ west))))
;; One stalk is taken from the east bundle and placed between the fingers of the left hand ;; One stalk is taken from the east bundle and placed between the fingers of the left hand
(setq east (1- east)) (setq east (1- east))
(setq left (1+ left)) (setq left (1+ left))
@ -813,14 +813,14 @@ Provided by Randomness and Integrity Services Ltd. via https://www.random.org/"
;; eight stalks results in the value of 2, four stalks results in the value of 3 ;; eight stalks results in the value of 2, four stalks results in the value of 3
(if (= 8 left) (if (= 8 left)
(setq result (+ result 2)) (setq result (+ result 2))
(setq result (+ result 3))) (setq result (+ result 3)))
;; three values are now added together to produce a total of 6, 7, 8, or 9 ;; three values are now added together to produce a total of 6, 7, 8, or 9
(pcase result (pcase result
(6 '(0 1)) ;; yin changing (6 '(0 1)) ;; yin changing
(7 '(1 1)) ;; yang (7 '(1 1)) ;; yang
(8 '(0 0)) ;; yin (8 '(0 0)) ;; yin
(9 '(1 0)) ;; yang changing (9 '(1 0)) ;; yang changing
))) )))
;; interpreting a hexagram ;; interpreting a hexagram
@ -846,16 +846,16 @@ Provided by Randomness and Integrity Services Ltd. via https://www.random.org/"
(changing (when (= 3 (length cast)) (changing (when (= 3 (length cast))
(string (elt cast 2)))) (string (elt cast 2))))
(result (result
(if changing (if changing
(format "%s → %s\n\n%s\n\n%s" (format "%s → %s\n\n%s\n\n%s"
hexagram changing hexagram changing
(i-ching-interpretation (i-ching-interpretation
(i-ching-hexagram-to-number hexagram)) (i-ching-hexagram-to-number hexagram))
(i-ching-interpretation (i-ching-interpretation
(i-ching-hexagram-to-number changing))) (i-ching-hexagram-to-number changing)))
(format "%s" (format "%s"
(i-ching-interpretation (i-ching-interpretation
(i-ching-hexagram-to-number hexagram)))))) (i-ching-hexagram-to-number hexagram))))))
(message "cast: %s\n" cast) (message "cast: %s\n" cast)
result)) result))