\ Source code from Ear Training


: MSEC	0 DO	9 0 DO LOOP	LOOP ;

CREATE RND HERE ,
: RANDOM	RND @ 31421 * 6927 + DUP RND ! ;
: CHOOSE	(u1 --- u2 )
  RANDOM U* SWAP DROP ;

: CRS	0 DO CR LOOP  ;

: POSITION	PAGE	10 CRS	15 SPACES ;

HEX
: NOTE	( pitch msec - )
  B6 43 P!
  B04000. 4 ROLL U/MOD SWAP DROP
  DUP FF AND 42 P!
	100 /	 42 P!
	61	P@	DUP 03 OR	61 P!	SWAP
  MSEC 61 P!	;
DECIMAL

2560 CONSTANT C
2712 CONSTANT C#
2873 CONSTANT D
3044 CONSTANT D#
3225 CONSTANT E
3417 CONSTANT F
3620 CONSTANT F#
3835 CONSTANT G
4063 CONSTANT G#
4304 CONSTANT A
4561 CONSTANT A#
4832 CONSTANT B

CREATE DURATION 4000 ,

1000 DURATION !

CREATE KEYS 256 ,

: PLAY ( pitch )
  KEYS @ 256 */ DURATION @ NOTE ;

: C1	C      PLAY ;
: C#1	C#     PLAY ;
: D1	D      PLAY ;
: D#1	D#     PLAY ;
: E1	E      PLAY ;
: F1	F      PLAY ;
: F#l	F#     PLAY ;
: G1	G      PLAY ;
: G#1	G#     PLAY ;
: A1	A      PLAY ;
: A#1	A#     PLAY ;
: B1	B      PLAY ;
: C2	C 2*   PLAY ;

: MAJOR		 C1 E1  G1  E1  C1 ;
: MINOR		 C1 D#1 G1  D#1 C1 ;
: DIMINISHED C1 D#1 F#1 D#1 C1 ;
: AUGMENTED	 C1 E1  G#1 E1  C1 ;

CREATE triads
' MAJOR      CFA ,
' MINOR      CFA ,
' DIMINISHED CFA ,
' AUGMENTED  CFA ,

CREATE keys
' C  CFA ,
' C# CFA ,
' D  CFA ,
' D# CFA ,
' E  CFA ,
' F  CFA ,
' F# CFA ,
' G  CFA ,
' G# CFA ,
' A  CFA ,
' A# CFA ,
' B  CFA ,

: TRIAD
  POSITION
  12 CHOOSE 2*  keys   + @ DUP EXECUTE KEYS
   4 CHOOSE 2 * triads + @ DUP EXECUTE
  BEGIN ?TERMINAL UNTIL
  POSITION
  SWAP ." Key of " 2+ NFA ID. 2+ NFA ID. ." triad. " CR
  BEGIN ?TERMINAL UNTIL ;

: TRIADS
  CR 100 0 DO TRIAD ?TERMINAL IF LEAVE THEN LOOP ;

: Perfect_unison   C1 C1  ;
: Minor_second     C1 C1# ;
: Major_second     C1 D1  ;
; Minor_third      C1 D#1 ;
: Major_third      C1 E1  ;
: Perfect_fourth   C1 F1  ;
: Augmented_fourth C1 F#1 ;
: Perfect_fifth    C1 G1  ;
: Minor_sixth      C1 G#1 ;
: Major_sixth      C1 A1  ;
: Minor_seventh    C1 A#1 ;
: Major_seventh    C1 B1  ;
: Perfect_octave   C1 C2  ; 

CREATE intervals
' Perfect_unison   CFA ,
' Minor_second     CFA ,
' Major_second     CFA ,
' Minor_third      CFA ,
' Major_third      CFA ,
' Perfect_fourth   CFA ,
' Augmented_fourth CFA ,
' Perfect_fifth    CFA ,
' Minor_sixth      CFA ,
' Major_sixth      CFA ,
' Minor_seventh    CFA ,
' Major_seventh    CFA ,
' Perfect_octave   CFA ,

: INTERVAL
  POSITION
  0 2* keys              + @ DUP EXECUTE	KEYS
  13 CHOOSE 2* intervals + @ DUP EXECUTE
  BEGIN ?TERMINAL UNTIL
  POSITION
  SWAP ." Key of " 2+ NFA ID. 2+ NFA ID. ." Interval. "  CR
  BEGIN ?TERMINAL UNTIL ;

: INTERVALS
  CR 100 0
  DO PAGE 12 CRS INTERVAL
  ?TERMINAL IF LEAVE THEN LOOP ;

: KEY&INTERVAL
  POSITION
  12 CHOOSE 2* keys       + @ DUP EXECUTE KEYS
  13 CHOOSE 2 * intervals + @ DUP EXECUTE
  BEGIN ?TERMINAL UNTIL
  POSITION
  SWAP ." Key of " 2+ NFA ID. 2+ NFA ID. ." Interval. " CR
  BEGIN ?TERMINAL UNTIL ;

: KEY&INTERVALS
  CR 100 0
  DO KEY&INTERVAL
  ?TERMINAL IF LEAVE THEN LOOP ;

: MENU
  PAGE 4 CRS 10 SPACES
  ." A TRIADS        " 2 CRS 10 SPACES
  ." B INTERVALS     " 2 CRS 10 SPACES
  ." C KEY&INTERVALS " 2 CRS 10 SPACES
  ." D QUIT          " 3 CRS 10 SPACES

." Enter the letter for the drill of your choice."
5 CRS ; 

: A	TRIADS        MENU ;
: B	INTERVALS     MENU ;
: C	KEY&INTERVALS MENU ;
: D	PAGE          BYE  ; EXIT