;;; -*-LISP-*-
;;; Phil Budne @ DEC
;;; (P '(6 1 7 4 6 7 4 9 3 9))
;;; Prints 'words' that can be dialed on a telephone to get my office
;;;
;;; Output is direccted thru ofile
 
(setq base 10. ibase 10.)
 
(array key-pad nil 10.)
 
(fillarray 'key-pad
	   '((48.)					;0
	     (49.)					;1
	     (65. 66. 67.)				;ABC
	     (68. 69. 70.)				;DEF
	     (71. 72. 73.)				;GHI
	     (74. 75. 76.)				;JKL
	     (77. 78. 79.)				;MNO
	     (80. 82. 83.)				;PRS
	     (84. 85. 86.)				;TUV
	     (87. 88. 89.)))				;WXY
 
;;; Deffault output is TTY 
(setq ofile tyo)
 
;;; Function to type words
(defun stuff (x) (princ x ofile) (tyo 9. ofile))
 
;;; Main user function
(defun p
       (list)
       (prog nil
	     (terpri ofile)
	     (princ '|Listing for phone number: | ofile)
	     (princ list ofile)
	     (terpri ofile)
	     (p2 list nil)
	     (terpri ofile)
	     (cond ((not (eq ofile tyo))
		    (close ofile)
		    (setq ofile tyo)))))
 
;;; Recursive helper function
(defun p2
       (list sofar)
       (cond ((null list) (stuff (implode sofar)))
	     (t (mapcar '(lambda (x)
				 (p2 (cdr list)
				     (append sofar (ncons x))))
			(key-pad (car list))))))