home *** CD-ROM | disk | FTP | other *** search
/ Set of Apple II Hard Drive Images / hard.hdv / HARD / FORTH / SOURCE / GUITAR.WRD < prev    next >
Encoding:
Text File  |  1995-05-29  |  3.6 KB  |  152 lines  |  [04] ASCII Text (0x0000)
  1. ( GUITAR )
  2.  
  3. DEC
  4.  
  5. 6 PARAMETERS GUITARNOTE
  6. 64 TO 0 GUITARNOTE
  7. 59 TO 1 GUITARNOTE
  8. 55 TO 2 GUITARNOTE
  9. 50 TO 3 GUITARNOTE 
  10. 45 TO 4 GUITARNOTE
  11. 40 TO 5 GUITARNOTE
  12.  
  13. 6 PARAMETERS GUITARSTRING
  14.  
  15. 0 TO 0 GUITARSTRING
  16. 0 TO 1 GUITARSTRING
  17. 0 TO 2 GUITARSTRING
  18. 0 TO 3 GUITARSTRING
  19. 0 TO 4 GUITARSTRING
  20. 0 TO 5 GUITARSTRING
  21.  
  22. 6 PARAMETERS PREVSTRING
  23.  
  24. 0 TO 0 PREVSTRING
  25. 0 TO 1 PREVSTRING
  26. 0 TO 2 PREVSTRING
  27. 0 TO 3 PREVSTRING
  28. 0 TO 4 PREVSTRING
  29. 0 TO 5 PREVSTRING
  30.  
  31. : GUITARCH ( N6 N5 N4 N3 N2 N1 -- ) ( -- )
  32.    CREATE C, C, C, C, C, C, DOES> 
  33.    DUP 0 + C@ 0 GUITARNOTE + TO 0 GUITARSTRING
  34.    DUP 1 + C@ 1 GUITARNOTE + TO 1 GUITARSTRING
  35.    DUP 2 + C@ 2 GUITARNOTE + TO 2 GUITARSTRING
  36.    DUP 3 + C@ 3 GUITARNOTE + TO 3 GUITARSTRING
  37.    DUP 4 + C@ 4 GUITARNOTE + TO 4 GUITARSTRING
  38.    DUP 5 + C@ 5 GUITARNOTE + TO 5 GUITARSTRING
  39.    DROP 
  40. ;
  41.  
  42. 255 PARAMETER X
  43.  
  44. : HUSH  ( NOTE # )
  45.    DUP X = IF DROP ELSE OFF THEN
  46. ;
  47. : PLICK  ( NOTE# )
  48.    DUP X = IF DROP ELSE ON THEN
  49. ;
  50.  
  51. ( FINGERPICKING )
  52. : P1 0 PREVSTRING HUSH  0 GUITARSTRING DUP TO 0 PREVSTRING PLICK ;
  53. : P2 1 PREVSTRING HUSH  1 GUITARSTRING DUP TO 1 PREVSTRING PLICK ;
  54. : P3 2 PREVSTRING HUSH  2 GUITARSTRING DUP TO 2 PREVSTRING PLICK ;
  55. : P4 3 PREVSTRING HUSH  3 GUITARSTRING DUP TO 3 PREVSTRING PLICK ;
  56. : P5 4 PREVSTRING HUSH  4 GUITARSTRING DUP TO 4 PREVSTRING PLICK ;
  57. : P6 5 PREVSTRING HUSH  5 GUITARSTRING DUP TO 5 PREVSTRING PLICK ;
  58.  
  59. : P321 P3 P2 P1 ;
  60. : P123 P1 P2 P3 ;
  61.  
  62. : STRUM P6 P5 P4 P3 P2 P1 ;
  63.  
  64. 0 0 2 2 2 0 GUITARCH AMAJ   
  65. 0 0 2 2 1 0 GUITARCH AMIN  
  66. 0 0 2 2 2 3 GUITARCH A7TH
  67. 1 1 3 3 3 1 GUITARCH A#MAJ
  68. 1 1 3 3 2 1 GUITARCH A#MIN
  69. 1 1 3 1 3 1 GUITARCH A#7TH
  70. 2 2 4 4 4 2 GUITARCH BMAJ
  71. 2 2 4 4 3 2 GUITARCH BMIN
  72. 2 2 1 2 0 2 GUITARCH B7TH
  73. 3 3 2 0 1 0 GUITARCH CMAJ
  74. 3 3 5 5 4 3 GUITARCH CMIN
  75. 3 3 2 3 1 0 GUITARCH C7TH
  76. 4 4 3 1 2 1 GUITARCH C#MAJ
  77. 4 4 6 6 5 4 GUITARCH C#MIN
  78. 4 4 6 4 6 4 GUITARCH C#7TH
  79. 2 0 0 2 3 2 GUITARCH DMAJ
  80. 1 0 0 2 3 1 GUITARCH DMIN
  81. 2 0 0 2 1 2 GUITARCH D7TH
  82. 3 1 1 3 4 3 GUITARCH D#MAJ
  83. 2 1 1 3 4 2 GUITARCH D#MIN
  84. 3 1 1 3 2 3 GUITARCH D#7TH
  85. 0 2 2 1 0 0 GUITARCH EMAJ
  86. 0 2 2 0 0 0 GUITARCH EMIN
  87. 0 2 2 1 3 0 GUITARCH E7TH
  88. 1 3 3 2 1 1 GUITARCH FMAJ
  89. 1 3 3 1 1 1 GUITARCH FMIN
  90. 1 3 1 2 1 1 GUITARCH F7TH
  91. 2 4 4 3 2 2 GUITARCH F#MAJ
  92. 2 4 4 2 2 2 GUITARCH F#MIN
  93. 2 4 2 3 2 2 GUITARCH F#7TH
  94. 3 2 0 0 0 3 GUITARCH GMAJ
  95. 3 5 5 3 3 3 GUITARCH GMIN
  96. 3 2 0 0 0 1 GUITARCH G7TH
  97. 4 6 6 4 5 4 GUITARCH G#MAJ
  98. 4 6 6 4 4 4 GUITARCH G#MIN 
  99. 4 6 4 5 4 4 GUITARCH G#7TH
  100.  
  101.  
  102. ( GUITAR )
  103.  
  104. : FINGERS ( N6 N5 N4 N3 N2 N1 -- )
  105.   DUP X = NOT IF  0 GUITARNOTE + THEN TO 0 GUITARSTRING  
  106.   DUP X = NOT IF  1 GUITARNOTE + THEN TO 1 GUITARSTRING  
  107.   DUP X = NOT IF  2 GUITARNOTE + THEN TO 2 GUITARSTRING  
  108.   DUP X = NOT IF  3 GUITARNOTE + THEN TO 3 GUITARSTRING  
  109.   DUP X = NOT IF  4 GUITARNOTE + THEN TO 4 GUITARSTRING  
  110.   DUP X = NOT IF  5 GUITARNOTE + THEN TO 5 GUITARSTRING 
  111. ;
  112.  
  113. \ EXAMPLE:
  114. \ X 3 0 2 1 1 FINGERS STRUM
  115.  
  116.  
  117.  
  118. ( GUITAR TABULATURE )
  119.  
  120. DEC
  121.  
  122. : DAMP ( STRING# -- )
  123. GUITARSTRING DUP 0= IF DROP ELSE OFF THEN
  124. ;
  125.  
  126. : DAMPALL
  127. 0 DAMP 1 DAMP 2 DAMP 3 DAMP 4 DAMP 5 DAMP
  128. ;
  129.  
  130. : TAB ( N6 N5 N4 N3 N2 N1 -- )
  131. DUP X = IF DROP ELSE 0 DAMP  0 GUITARNOTE + DUP TO 0 GUITARSTRING ON THEN
  132. DUP X = IF DROP ELSE 1 DAMP  1 GUITARNOTE + DUP TO 1 GUITARSTRING ON THEN
  133. DUP X = IF DROP ELSE 2 DAMP  2 GUITARNOTE + DUP TO 2 GUITARSTRING ON THEN
  134. DUP X = IF DROP ELSE 3 DAMP  3 GUITARNOTE + DUP TO 3 GUITARSTRING ON THEN
  135. DUP X = IF DROP ELSE 4 DAMP  4 GUITARNOTE + DUP TO 4 GUITARSTRING ON THEN
  136. DUP X = IF DROP ELSE 5 DAMP  5 GUITARNOTE + DUP TO 5 GUITARSTRING ON THEN
  137. ;
  138.  
  139. \ EXAMPLE:
  140. \
  141. \ : CHATTA1
  142. \ X 3 X X X X TAB EN. //
  143. \ X X X 0 X X TAB SN  //
  144. \ X X X 2 X X TAB EN. //
  145. \ X X X 0 X X TAB SN  //
  146. \ 3 X X X X X TAB EN. //
  147. \ X X X 0 X X TAB SN  //
  148. \ X X X 2 X X TAB EN. //
  149. \ X X X 0 X X TAB SN  //
  150. \ ;
  151.  
  152.