home *** CD-ROM | disk | FTP | other *** search
/ Set of Apple II Hard Drive Images / hard.hdv / HARD / FORTH / SOURCE / STYLINGS.WRD < prev   
Encoding:
Text File  |  1994-03-01  |  2.4 KB  |  102 lines  |  [04] ASCII Text (0x0000)
  1. \ PIANO STYLINGS
  2. \
  3. \ EXAMPLE:
  4. \
  5. \  HN  4 OCT C MELODY   F MAJ7 G BASS LOW   CHORD
  6.  
  7.     
  8. \ INTERVALS USED FOR CONSTRUCTING CHORDS:
  9.  
  10. 0 CONSTANT ROOT
  11. 1 CONSTANT +ROOT    1 CONSTANT -9TH
  12. 2 CONSTANT 9TH
  13. 3 CONSTANT +9TH     3 CONSTANT -3RD
  14. 4 CONSTANT 3RD
  15. 5 CONSTANT 4TH      5 CONSTANT 11TH
  16. 6 CONSTANT +4TH     6 CONSTANT -5TH    6 CONSTANT +11TH
  17. 7 CONSTANT 5TH
  18. 8 CONSTANT +5TH     8 CONSTANT -13TH
  19. 9 CONSTANT 6TH      9 CONSTANT 13TH
  20. 10 CONSTANT -7TH   10 CONSTANT +13TH
  21. 11 CONSTANT 7TH
  22.  
  23. \ =====================================
  24.  
  25. 5 PARAMETERS CHORDARRAY
  26. 0 TO 0 CHORDARRAY        \ BASS NOTE
  27. 0 TO 1 CHORDARRAY
  28. 0 TO 2 CHORDARRAY
  29. 0 TO 3 CHORDARRAY
  30. 0 TO 4 CHORDARRAY
  31.  
  32.  
  33. : BASS ( NOTE# -- )
  34.    12 MOD                 \ EXTRACT NOTE VALUE 0-11
  35.    36 +                   \ PUT IN LOW REGISTER
  36.    DUP 41 < IF 12 + THEN  \ BUT MAKE RANGE F-E
  37.    TO 0 CHORDARRAY
  38. ; 
  39.  
  40. : LOW  0 CHORDARRAY 12 - TO 0 CHORDARRAY ;
  41.  
  42. : HIGH 0 CHORDARRAY 12 + TO 0 CHORDARRAY ;
  43.  
  44.  
  45. : QUALITY ( N1 N2 N3 N4 -- ) ( KEY -- )       
  46. CREATE C, C, C, C, DOES> 
  47. OVER BASS
  48. SWAP 12 MOD SWAP
  49. OVER OVER     C@ +  12 MOD  TO 1 CHORDARRAY 
  50. OVER OVER 1+  C@ +  12 MOD  TO 2 CHORDARRAY
  51. OVER OVER 2 + C@ +  12 MOD  TO 3 CHORDARRAY
  52.           3 + C@ +  12 MOD  TO 4 CHORDARRAY ;                                          
  53. \ =====================================
  54.  
  55. ROOT 3RD  5TH  ROOT  QUALITY MAJ 
  56. ROOT -3RD 5TH  ROOT  QUALITY MIN
  57. ROOT 3RD  +5TH ROOT  QUALITY AUG
  58. ROOT -3RD -5TH ROOT  QUALITY DIM
  59. ROOT 4TH  5TH  ROOT  QUALITY SUS4
  60.  
  61. ROOT 3RD  5TH  6TH   QUALITY MAJ6
  62. ROOT -3RD 5TH  6TH   QUALITY MIN6
  63.  
  64. ROOT 3RD  5TH  7TH   QUALITY MAJ7
  65. ROOT 3RD  5TH  -7TH  QUALITY DOM7
  66. ROOT -3RD 5TH  -7TH  QUALITY MIN7
  67. ROOT -3RD -5TH -7TH  QUALITY HALFDIM
  68. ROOT -3RD -5TH 6TH   QUALITY DIM7
  69. ROOT -3RD 5TH  7TH   QUALITY MINMAJ7
  70.  
  71. 3RD  5TH  7TH  9TH   QUALITY MAJ9
  72. 3RD  5TH  -7TH 9TH   QUALITY DOM9
  73. -3RD 5TH  -7TH 9TH   QUALITY MIN9
  74.  
  75. 5TH  -7TH 9TH  11TH  QUALITY DOM11
  76. 3RD  -7TH 9TH  +11TH QUALITY AUG11
  77. -3RD -7TH 9TH  11TH  QUALITY MIN11
  78.  
  79. -7TH 9TH  3RD  13TH  QUALITY DOM13
  80.  
  81. \ ===================================
  82.  
  83. 0 PARAMETER MEL-NOTE
  84.   
  85. : MELODY  ( NOTE# -- ) TO MEL-NOTE ;
  86.    
  87. : ADJUST-NOTE ( CHORDNOTE -- POSITIONED UNDER MELODY NOTE)
  88.     DUP MEL-NOTE 12 MOD > IF 12 - THEN
  89.     MEL-NOTE 12 / 12 * + 
  90. ;
  91.  
  92. : CHORD
  93.    MEL-NOTE                   
  94.    4 CHORDARRAY ADJUST-NOTE  
  95.    3 CHORDARRAY ADJUST-NOTE   
  96.    2 CHORDARRAY ADJUST-NOTE   
  97.    1 CHORDARRAY ADJUST-NOTE   
  98.    0 CHORDARRAY               
  99.  
  100.    6 CD
  101. ;
  102.