;;;
;;; c:\\program files\\acl62\\music34.cl
;;;
(load "c:\\program files\\acl62\\music33.cl")
(defun get-a-UST-from-a-pair-at-random (pair)
(let* ((l1 (assoc (second pair) (get-UST (first pair))))
(l2 (rest (second l1)))
(len (length l2)))
(nth (random len) l2)))
(defun get-n-USTs-from-a-pair-at-random (pair n)
(do ((num n (1- num))
(w))
((< num 1) (reverse w))
(push (get-a-UST-from-a-pair-at-random pair) w)))
(defun get-8-USTs-from-pairs-at-random-aux (pairs)
(do ((lst pairs (cddr lst))
(w))
((null lst) (reverse w))
(push (list (first lst) (get-n-USTs-from-a-pair-at-random (list (first lst) (second lst)) 8)) w)))
(defun get-8-USTs-from-pairs-at-random (pairs)
(do ((lst pairs (cdr lst)))
((null lst))
(print '**************************************************************)
(print (car lst))
(print (get-8-USTs-from-pairs-at-random-aux (car lst)))))
;;;
;;; (indicate-8-USTs-at-random *w1*)
;;;
(defun indicate-8-USTs-at-random (wn)
(tagbody
(my-randomize)
(format t "~%***** ~a *****" (second (first wn)))
(format t "~%The original key is ~a." (first (first wn)))
(format t "~%Enter a key.")
loop1
(setf l1 (read-sentence))
(if (not (key-p (car l1))) (go loop1))
(if (equal (car l1) (first (first wn)))
(setf l2 (cdr wn))
(setf l2 (modulate-key1-to-key2 (cdr wn) (first (first wn)) (car l1))))
(format t "~%***** The key is ~a. *****" (car l1))
(get-8-USTs-from-pairs-at-random l2)))