LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760032769. :SYSTEM-TYPE :LOGICAL :VERSION 2. :TYPE "LISP" :NAME "PIANO" :DIRECTORY ("REL3-PUBLIC" "PUBLIC" "MUSIC-DEMO") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-PUBLIC\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2755701861. :AUTHOR "REL3" :LENGTH-IN-BYTES 4885. :LENGTH-IN-BLOCKS 5. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       ;;; -*- Mode:Common-Lisp; Package:DEMO; Base:10 -*-;Date: 15-Dec-86 09:13:17;From: SAENZ@ZERMATT.ARPA;To:   oren.ti-csl@csnet-relay.arpa;Subj: The piano program;;; This was written by Johnn@VX; he also is the guy working on the;;; music editor, so you might want to correspond with him directly;;; about that.(defparameter VOICES 3)(defparameter middle-c 50)(defun make-tone-table()  (let ((it (make-array (list VOICES 128)))(halftone (exp (/ (log 2.0) 12.0)))freq)    (setq freq 256.0)    (loop for note from middle-c downto 1 do  (loop for voice from 0 below VOICES do(setf (aref it voice note)      (tv:tone voice (round freq))))  (setq freq (/ freq halftone)))    (setq freq 256.0)    (loop for note from middle-c below 128 do  (loop for voice from 0 below VOICES do(setf (aref it voice note)      (tv:tone voice (round freq))))  (setq freq (* freq halftone)))    it))(defvar tone-table (make-tone-table))(defparameter keyboard-table-size 34)(defparameter keyboard-table  (make-array keyboard-table-size :initial-contents      (list #\q #\2 #\w #\3 #\e #\r #\5 #\t #\6 #\y #\7 #\u    #\i #\9 #\o #\0 #\p    :left-shift #\a #\z #\s #\x #\c #\f #\v #\g #\b #\h #\n    #\m #\k #\, #\l #\.)))(defparameter note-table  (make-array keyboard-table-size :initial-contents      (list  0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16    12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28)))(defparameter off-volume 15)(defvar sound-envelope (make-array 20 :initial-contents   (list 0 0 0 1 2 3 4 5 6 7 7 7 7 7 7 7 7 7 7 7)))(defparameter envelope-duration 15)(defparameter maximum-duration (* envelope-duration (array-dimension sound-envelope 0)))(defun piano ()  (let ((low-key (- middle-c 12))(keyboard-alloc (make-array keyboard-table-size :initial-value nil))(keyboard-count (make-array keyboard-table-size :initial-value 0))(voice-alloc (make-array VOICES :initial-value nil)))    (funcall tv:selected-window :clear-screen)    (funcall tv:selected-window :line-out "PIANO")    (funcall tv:selected-window :line-out "")    (funcall tv:selected-window :line-out "Q               low-C")    (funcall tv:selected-window :line-out "I, LEFT-SHIFT   middle-C")    (funcall tv:selected-window :line-out "M               high-C")    (funcall tv:selected-window :line-out "")    (funcall tv:selected-window :line-out "ESCAPE          edit sound envelope")    (funcall tv:selected-window :line-out "END             exit")    (funcall tv:selected-window :line-out "")    (tv:reset-sound)    (tv:sib-sound-bit :on)    (loop always (not (tv:key-state #\end)) do  (read-char-no-hang)  (if (tv:key-state #\escape)      (modify-sound-envelope))  (loop for key from 0 below keyboard-table-size do(if (tv:key-state (aref keyboard-table key))    (if (not (aref keyboard-alloc key))(loop for voice from 0 below VOICES do      (when (and (not (aref voice-alloc voice)) (not (aref keyboard-alloc key)))(setf (aref voice-alloc voice) key)(setf (aref keyboard-alloc key) voice)(setf (aref keyboard-count key) 0)(tv:do-sound (tv:volume voice (aref sound-envelope 0)))(tv:do-sound (aref tone-table voice (+ (aref note-table key) low-key)))))(let ((voice (aref keyboard-alloc key))      (count (aref keyboard-count key)))  (setf (aref keyboard-count key) (1+ count))  (when (and (= (mod count envelope-duration) 0)     (< count maximum-duration))    (tv:do-sound (tv:volume voice (aref sound-envelope (floor count envelope-duration)))))))    (if (aref keyboard-alloc key)(let ((voice (aref keyboard-alloc key)))  (setf (aref voice-alloc voice) nil)  (setf (aref keyboard-alloc key) nil)  (tv:do-sound (tv:volume voice off-volume)))))))    (tv:reset-sound)    (read-char-no-hang)))(defparameter name-array (make-array 16 :initial-contents '(x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15)))(defun modify-sound-envelope ()  (let ((time-list nil)(vol-list nil)temp-list)    (loop for time from (1- (array-dimension sound-envelope 0)) downto 0 do  (setq temp-list nil)  (loop for vol from 0 to off-volume do(setq temp-list (cons (if (= (aref sound-envelope time) vol)  (list (aref name-array vol) t)  (aref name-array vol))      temp-list)))  (setq time-list (cons (list time (format nil "~d" time) temp-list)time-list)))    (loop for vol from 0 to off-volume do  (setq vol-list (cons (list (aref name-array vol) "")       vol-list)))    (setq temp-list (tv:multiple-choose "louder ->" time-list vol-list))    (if temp-list(loop for time from 0 below (array-dimension sound-envelope 0) do      (setf (aref sound-envelope time)    (parse-integer (string (cadar temp-list)) :start 1))      (setq temp-list (cdr temp-list))))))f str i) char))) i)))  (WHEN (PLUSP (aref *scale* char))    (tv:simple-beep (aref *scale* char) (* *speed* (- ii where))))  (setq where (1- ii))  (go L))))(defun play (thing)  (cond ((stringp thing) (play-string thing))((s