ORGAN  ;		* * * * * * * * * * * * *
 ;		*  PROGRAM BY KIM WATT  *
 ;		* BREEZE COMPUTING INC. *
 ;		*     P.O. BOX  1013    *
 ;		* BERKLEY, MICH.  48072 *
 ;		*    (313)  288-9422    *
 ;		* * * * * * * * * * * * *
 ;
 ;	SOUND ROUTINE TO TURN TRS-80 KEYBOARD
 ;	     INTO AND "ORGAN"
 ;	PRESS ANY LETTER KEY TO PLAY A NOTE
 ;	PRESS ANY NUMBER KEY TO CHANGE OVERTONES
 ;	PRESS LEFT AND RIGHT ARROW KEYS
 ;		WITH AND WITHOUT <SHIFT> FOR SCALES
 ;	HITTING <BREAK> RETURNS CONTROL TO BASIC
 ;		WITH NO INITIALIZATION
 ;
 	ORG	6500H
 ENTRY	DI
 	LD	SP,42E7H
 	LD	HL,3C00H
 	LD	DE,3C01H
 	LD	BC,1024
 	LD	(HL),32
 	LDIR
 	LD	HL,SCR101
 	LD	DE,15360+19
 	LD	BC,24
 	LDIR
 	LD	HL,SCR102
 	LD	DE,15360+64+21
 	LD	BC,20
 	LDIR
 	LD	HL,SCR103
 	LD	DE,15360+320+26
 	LD	BC,11
 	LDIR
 	LD	HL,SCR104
 	LD	DE,15360+384+22
 	LD	BC,18
 	LDIR
 	LD	HL,SCR105
 	LD	DE,15360+448+22
 	LD	BC,18
 	LDIR
 	LD	HL,SCR106
 	LD	DE,15360+512+21
 	LD	BC,20
 	LDIR
 	LD	HL,SCR107
 	LD	DE,15360+576+22
 	LD	BC,18
 	LDIR
 	LD	HL,SCR108
 	LD	DE,15360+640+24
 	LD	BC,14
 	LDIR
 	LD	HL,SCR109
 	LD	DE,15360+768+26
 	LD	BC,10
 	LDIR
 KYSTOP	LD	A,(14400)
 	OR	A
 	JR	NZ,KYSTOP
 LOOP2	LD	A,(14400)
 	CP	1
 	JR	NZ,LOOP2
 	LD	HL,15360+128
 	LD	DE,15360+129
 	LD	(HL),32
 	LD	BC,896
 	LDIR
 	LD	HL,SCR201
 	LD	DE,15360+320+15
 	LD	BC,32
 	LDIR
 	LD	HL,SCR202
 	LD	DE,15360+384+12
 	LD	BC,38
 	LDIR
 	LD	HL,SCR203
 	LD	DE,15360+448+5
 	LD	BC,52
 	LDIR
 	LD	HL,SCR909
 	LD	DE,15360+512+16
 	LD	BC,30
 	LDIR
 	LD	HL,SCR204
 	LD	DE,15360+640+21
 	LD	BC,19
 	LDIR
 	LD	HL,SCR205
 	LD	DE,15360+704+25
 	LD	BC,15
 	LDIR
 	LD	HL,SCR206
 	LD	DE,15360+768+22
 	LD	BC,18
 	LDIR
 	JP	ROUTIN
 SCR909	DEFM	'PRESS MANY KEYS FOR MORE FUN! '
 SCR101	DEFM	'>> TRS-80 SYNTHESIZER <<'
 SCR102	DEFM	'* BREEZE COMPUTING *'
 SCR103	DEFM	'BY KIM WATT'
 SCR104	DEFM	'COPYRIGHT (C) 1980'
 SCR105	DEFM	'LEVEL IV  PRODUCTS'
 SCR106	DEFM	'32238 SCHOOLCRAFT F4'
 SCR107	DEFM	'LIVONIA, MI. 48154'
 SCR108	DEFM	'(313) 525-6200'
 SCR109	DEFM	'HIT ENTER!'
 SCR201	DEFM	'HIT ANY LETTER KEY TO PLAY TONE.'
 SCR202	DEFM	'HIT ANY NUMBER KEY TO CHANGE OVERTONE.'
 SCR203	DEFM	'     USE ARROW KEYS (+/-SHIFT) TO CH'
 	DEFM	'ANGE SCALE.     '
 SCR204	DEFM	'FREQUENCY CODE: 00H'
 SCR205	DEFM	'SCALE CODE: 00H'
 SCR206	DEFM	'OVERTONE CODE: 00H'
 ROUTIN	CALL	DISPLY
 GOGO	CALL	GETKEY
 	CALL	PLANOT
 	JR	GOGO
 DISPLY	LD	A,(BYTE1)
 	CALL	CONVER
 	EX	DE,HL
 	LD	HL,15360+677
 	LD	(HL),D
 	INC	HL
 	LD	(HL),E
 	LD	A,(BYTE4)
 	OR	A
 	JR	NZ,UULLTT
 	LD	A,(BYTE2)
 	CP	0
 	JR	Z,HIGHH
 	CP	1
 	JR	Z,HIGHL
 	CP	2
 	JR	Z,LOWH
 	CP	3
 	JR	Z,LOWL
 	LD	A,(BYTE4)
 	OR	A
 	JR	Z,LOWL
 UULLTT	LD	HL,15360+741
 	LD	(HL),55H
 	INC	HL
 	LD	(HL),4CH
 	INC	HL
 	LD	(HL),54H
 	INC	HL
 	LD	(HL),52H
 	INC	HL
 	LD	(HL),41H
 	JR	OVER
 LOWL	LD	HL,15360+741
 	LD	(HL),76
 	INC	HL
 	LD	(HL),79
 	INC	HL
 	LD	(HL),87
 	INC	HL
 	LD	(HL),33
 	INC	HL
 	LD	(HL),32
 	JP	OVER
 HIGHH	LD	HL,15360+741
 	LD	(HL),72
 	INC	HL
 	LD	(HL),73
 	INC	HL
 	LD	(HL),71
 	INC	HL
 	LD	(HL),72
 	INC	HL
 	LD	(HL),33
 	JR	OVER
 LOWH	LD	HL,15360+741
 	LD	(HL),76
 	INC	HL
 	LD	(HL),79
 	INC	HL
 	LD	(HL),87
 	INC	HL
 	LD	(HL),32
 	INC	HL
 	LD	(HL),32
 	JR	OVER
 HIGHL	LD	HL,15360+741
 	LD	(HL),48H
 	INC	HL
 	LD	(HL),49H
 	INC	HL
 	LD	(HL),47H
 	INC	HL
 	LD	(HL),48H
 	INC	HL
 	LD	(HL),32
 OVER	LD	A,(BYTE3)
 	DEC	A
 	CALL	CONVER
 	EX	DE,HL
 	LD	HL,15360+805
 	INC	E
 	LD	(HL),30H
 	INC	HL
 	LD	(HL),E
 	INC	HL
 	LD	(HL),20H
 	INC	HL
 	LD	(HL),20H
 	LD	A,(15360+806)
 	CP	47H
 	RET	NZ
 	LD	A,30H
 	LD	(15360+806),A
 	RET
 CONVER	LD	C,A
 	SRL	A
 	SRL	A
 	SRL	A
 	SRL	A
 	CALL	TEST
 	LD	H,A
 	LD	A,C
 	AND	0FH
 	CALL	TEST
 	LD	L,A
 	RET
 TEST	ADD	A,30H
 	CP	3AH
 	JP	M,TEST1
 	ADD	A,7
 TEST1	RET
 PLANOT	LD	A,(BYTE1)
 	CP	0
 	JR	NZ,PLAYIT
 	RET
 PLAYIT	CALL	DISPLY
 SOK	LD	A,(BYTE3)
 TOK	LD	L,A
 CONTIN	LD	A,(BYTE2)
 	LD	D,A
 	LD	A,(BYTE1)
 	LD	E,A
 	LD	B,1
 	LD	C,0FFH
 	OUT	(C),B
 LOOPA	DEC	DE
 	LD	A,D
 	OR	E
 	JR	NZ,LOOPA
 	LD	B,2
 	LD	A,(BYTE2)
 	LD	D,A
 	LD	A,(BYTE1)
 	LD	E,A
 	OUT	(C),B
 LOOPB	DEC	DE
 	LD	A,D
 	OR	E
 	JR	NZ,LOOPB
 	DEC	L
 	JP	NZ,CONTIN
 	RET
 BYTE1	DEFB	00
 BYTE2	DEFB	00
 BYTE3	DEFB	10H
 BYTE4	DEFB	0
 ABC	JP	DISPLY
 GETKEY	CALL	FINDKY
 	OR	A
 	JR	Z,NOKEY
 	CP	30H
 	JP	Z,WOOZY
 	CP	9
 	JP	Z,RARR
 	CP	91
 	JP	Z,ULTRAH
 	CP	19H
 	JP	Z,SRARR
 	CP	8
 	JP	Z,LARR
 	CP	18H
 	JP	Z,SLARR
 	CP	3AH
 	JP	C,NUMBER
 SFIX	LD	HL,TABLEK
 	LD	DE,2
 	LD	C,33
 	CALL	SEARCH
 	JR	NZ,NOKEY
 	JR	HAVNOT
 NOKEY	XOR	A
 	LD	(BYTE1),A
 	RET
 WOOZY	LD	A,10H
 	LD	(BYTE3),A
 	CALL	DISPLY
 	RET
 SEARCH	LD	B,0
 SLOOP1	CPI
 	JR	Z,FOUND
 	JP	PO,NFND
 	ADD	HL,DE
 	DEC	HL
 	JR	SLOOP1
 FOUND	DEC	HL
 NFND	RET
 HAVNOT	INC	HL
 	LD	A,(HL)
 	LD	(BYTE1),A
 	LD	A,(BYTE4)
 	OR	A
 	RET	Z
 	LD	A,(BYTE1)
 	SRL	A
 	SRL	A
 	LD	(BYTE1),A
 	RET
 TABLEK	DEFB	'Q'
 	DEFB	185
 	DEFB	'W'
 	DEFB	174
 	DEFB	'E'
 	DEFB	164
 	DEFB	'R'
 	DEFB	155
 	DEFB	'T'
 	DEFB	147
 	DEFB	'Y'
 	DEFB	138
 	DEFB	'U'
 	DEFB	131
 	DEFB	'I'
 	DEFB	123
 	DEFB	'O'
 	DEFB	116
 	DEFB	'P'
 	DEFB	110
 	DEFB	'@'
 	DEFB	104
 	DEFB	'A'
 	DEFB	98
 	DEFB	'S'
 	DEFB	92
 	DEFB	'D'
 	DEFB	87
 	DEFB	'F'
 	DEFB	82
 	DEFB	'G'
 	DEFB	78
 	DEFB	'H'
 	DEFB	73
 	DEFB	'J'
 	DEFB	69
 	DEFB	'K'
 	DEFB	65
 	DEFB	'L'
 	DEFB	62
 	DEFB	';'
 	DEFB	58
 	DEFB	'Z'
 	DEFB	55
 	DEFB	'X'
 	DEFB	52
 	DEFB	'C'
 	DEFB	49
 	DEFB	'V'
 	DEFB	46
 	DEFB	'B'
 	DEFB	44
 	DEFB	'N'
 	DEFB	41
 	DEFB	'M'
 	DEFB	39
 	DEFB	'<'
 	DEFB	37
 	DEFB	'>'
 	DEFB	35
 	DEFB	'?'
 	DEFB	33
 	DEFB	91
 	DEFB	0
 	DEFM	'0'
 	DEFB	0
 	DEFM	'0000000000'
 SLARR	LD	A,3
 	LD	(BYTE2),A
 	XOR	A
 	LD	(BYTE4),A
 	CALL	DISPLY
 	RET
 LARR	LD	A,2
 	LD	(BYTE2),A
 	XOR	A
 	LD	(BYTE4),A
 	CALL	DISPLY
 	RET
 RARR	LD	A,1
 	LD	(BYTE2),A
 	XOR	A
 	LD	(BYTE4),A
 	CALL	DISPLY
 	RET
 SRARR	XOR	A
 	LD	(BYTE2),A
 	XOR	A
 	LD	(BYTE4),A
 	CALL	DISPLY
 	RET
 ULTRAH	LD	A,4
 	LD	(BYTE4),A
 	XOR	A
 	LD	(BYTE2),A
 	CALL	DISPLY
 	RET
 NUMBER	LD	B,48
 	CP	B
 	JP	C,SFIX
 	SUB	B
 	LD	(BYTE3),A
 	CALL	DISPLY
 	RET
 FINDKY	LD	B,3FH
 	LD	A,(3801H)
 	OR	A
 	JR	NZ,GOTZIT
 	LD	B,47H
 	LD	A,(3802H)
 	OR	A
 	JR	NZ,GOTZIT
 	LD	B,4FH
 	LD	A,(3804H)
 	OR	A
 	JR	NZ,GOTZIT
 	LD	B,57H
 	LD	A,(3808H)
 	OR	A
 	JR	NZ,GOTZIT
 	LD	B,2FH
 	LD	A,(3810H)
 	OR	A
 	JR	NZ,GOTZIT
 	LD	B,37H
 	LD	A,(3820H)
 	OR	A
 	JR	NZ,GOTZIT
 	LD	A,(3840H)
 	OR	A
 	JR	NZ,SPECL
 	XOR	A
 	RET
 GOTZIT	LD	E,B
 	LD	B,0
 GGHR	INC	B
 	RRA
 	JR	NC,GGHR
 	LD	A,B
 	ADD	A,E
 	RET
 SPECL	CP	2
 	JP	Z,ENTRY
 	CP	8
 	JR	Z,UPSY
 	CP	4
 	JP	Z,0H
 	CP	32
 	JR	Z,TAR
 	CP	64
 	JR	Z,TAR
 	XOR	A
 	RET
 UPSY	LD	A,91
 	RET
 TAR	CP	32
 	LD	A,8
 	JR	Z,NTAR
 	INC	A
 NTAR	LD	E,A
 	LD	A,(3880H)
 	OR	A
 	LD	A,0
 	JR	Z,NTTAR
 	LD	A,10H
 NTTAR	OR	E
 	RET
 	END	ENTRY
