home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 January - Disc 2 / Macworld (1999-01) (Disk 2).dmg / Serious Demos / Symbolic Composer 4.2 / Environment / Projects / Questions & Answers / Q&A Programming Functions / Gen-expansion enhancement < prev    next >
Encoding:
Text File  |  1998-10-26  |  1.4 KB  |  52 lines  |  [TEXT/ScoM]
  1. GEN-EXPANSION ENHANCEMENT
  2.  
  3. Here is gen-expansion enhancement invented by Harm Visser. Check
  4. out (gen-expansion-int 4 '(1 2) '( 1 -2)) in visualizer with different
  5. input values! The results play nice on chromatic scale, but I tweaked
  6. it a little so that it works with scales with less notes...
  7.  
  8. ; gen-expansion-int
  9. ; Harm Visser <hvisser@worldaccess.nl>
  10.  
  11. (defun transpose-to-int (base pattern)
  12.   (append (change-length add base pattern) (change-length times base pattern)))
  13.  
  14. (defun gen-expansion-int (level list expansion)
  15.   (let ((out list))
  16.     (do-quietly
  17.       (dotimes (i level)
  18.         (setq out (tr-expand-pattern-int out expansion)))
  19.       out)))
  20.  
  21. (defun tr-expand-pattern-int (pattern expansion)
  22.   (let (out)
  23.     (dolist (x pattern)
  24.       (push (nreverse (transpose-to-int x expansion)) out))
  25.     (nreverse (flatten out))))
  26.  
  27. (defun zerobase-integers (l)
  28.   (let ((minval (find-min-value l)))
  29.     (mapcar #'(lambda (x) (+ (abs minval) x)) l)))
  30.  
  31. (setq symbols (gen-expansion-int 4 '(1 2) '( 1 -2)))
  32.  
  33. (def-section a
  34.    default
  35.       zone (* (length symbols) (get-tick '1/16))
  36.       tonality (activate-tonality (hirajoshi c 3))
  37.       length '(1/16)
  38.       duration '(1/10)
  39.       velocity '(74 64 84 74 94 64 74 54)
  40.    piano
  41.       symbol (symbol-fold 7 0 (change-to-symbols (zerobase-integers symbols)))
  42.       channel 11
  43. )
  44.  
  45. (midiport :printer)
  46. (def-tempo 90)
  47.  
  48. (play-file-p "test"
  49.    piano '(a)
  50. )
  51.  
  52.