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

䷰ Metamorphosis

Browse source 
Firm correctness abolishes regret and brings successful progress.
This commit is contained in:
nik gaffney 2021-01-11 10:30:58 +01:00
parent 0f492e3823
commit c6836aee32
2 changed files with 18 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
i-ching.el
View file

@ -710,17 +710,16 @@ Provided by Randomness and Integrity Services Ltd. via https://www.random.org/"
(defun i-ching--three-coins () (defun i-ching--three-coins ()
"Simulate 3 coins. The retrn value is a pair of lines." "Simulate 3 coins. The retrn value is a pair of lines."
(cl-letf (((symbol-function 'coin-toss) #'i-ching--coin-toss)) (let ((result (+ (i-ching--coin-toss)
(let ((result (+ (coin-toss) (i-ching--coin-toss)
(coin-toss) (i-ching--coin-toss))))
(coin-toss))))
;; single hexagram. no changing lines ;; single hexagram. no changing lines
(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
)))) )))
(defun i-ching--yarrow-stalks () (defun i-ching--yarrow-stalks ()
"Cast simulated yarrow stalks, return a value for a line, or changing line..." "Cast simulated yarrow stalks, return a value for a line, or changing line..."
@ -733,7 +732,7 @@ Provided by Randomness and Integrity Services Ltd. via https://www.random.org/"
;; One stalk is set aside and not used again ;; One stalk is set aside and not used again
(setq yarrow-stalks (1- yarrow-stalks)) (setq yarrow-stalks (1- yarrow-stalks))
;; The bundle of the remaining stalks is divided into two bundles ;; The bundle of the remaining stalks is divided into two bundles
(dotimes (i 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))))
@ -757,7 +756,7 @@ Provided by Randomness and Integrity Services Ltd. via https://www.random.org/"
(setq yarrow-stalks (- yarrow-stalks left)) (setq yarrow-stalks (- yarrow-stalks left))
(setq east 0 west 0 left 0 group 0) (setq east 0 west 0 left 0 group 0)
;; The bundle of the remaining stalks is divided into two bundles ;; The bundle of the remaining stalks is divided into two bundles
(dotimes (i 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))))
@ -784,7 +783,7 @@ Provided by Randomness and Integrity Services Ltd. via https://www.random.org/"
(setq yarrow-stalks (- yarrow-stalks left)) (setq yarrow-stalks (- yarrow-stalks left))
(setq east 0 west 0 left 0 group 0) (setq east 0 west 0 left 0 group 0)
;; The bundle of the remaining stalks is divided into two bundles ;; The bundle of the remaining stalks is divided into two bundles
(dotimes (i 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))))
@ -854,7 +853,7 @@ Provided by Randomness and Integrity Services Ltd. via https://www.random.org/"
"Consult the I Ching using a particular METHOD." "Consult the I Ching using a particular METHOD."
(interactive) (interactive)
(read-string "What is your question? ") (read-string "What is your question? ")
(let* ((query (i-ching-query-string 'method)) (let* ((query (i-ching-query-string method))
(reading-buffer (get-buffer-create "*The I Ching*"))) (reading-buffer (get-buffer-create "*The I Ching*")))
(with-current-buffer reading-buffer (with-current-buffer reading-buffer
(goto-char (point-min)) (goto-char (point-min))

4
tests.el
View file

@ -35,6 +35,10 @@
(should (stringp (i-ching-cast '3-coins))) (should (stringp (i-ching-cast '3-coins)))
(should (stringp (i-ching-cast)))) (should (stringp (i-ching-cast))))
;; (i-ching-query '6-bit)
;; (i-ching-query '3-coins)
;; (i-ching-query 'yarrow-stalks)
(ert t) (ert t)
;;; tests.el ends here ;;; tests.el ends here