;	ALPHA-NUMERIC MUSIC WITH AMPLITUDE CONTROL
;
;	COPYRIGHT 1975 BY MALCOLM T. WRIGHT
;
;	AVAILABLE FROM: PEOPLE'S COMPUTER COMPANY
;			BOX 310
;			MENLO PARK, CALIFORNIA 94025
;
PORT	EQU	02H		;PARALLEL OUTPUT PORT
;
	ORG	100H
	LXI	H,TABLE		;START OF MUSIC TABLE
NEXT	INX	H
	MOV	A,M
	ANI	7FH		;ERASE PARITY
	LXI	D,NEXT		;LOAD STACK WITH RETURN ADDR
	PUSH	D		;FOR CHARACTER SEARCH
	NOP
	CPI	'L'		;IS THE CHARACTER AN 'L' ?
	JNZ	CTRLA
LEAVE	INX	SP
	INX	SP
	RET			;RETURN TO SUPERVISOR PROG.
CTRLA	CPI	'A'-40H		;IS IT A CONTROL A ?
	JNZ	CTRLE
	STA	SAVEF		;SAVE CTRL-A AS FLAG
	RET			;RETURN TO NEXT
CTRLE	CPI	'E'-40H		;IS IT A CONTROL-E ?
	JZ	ENVEL		;GO TO ENVELOPE ROUTINE
	CPI	'V'-40H		;IS IT A CONTROL-V ?
	JZ	VOL		;GO TO VOLUME ROUTINE
	CPI	'T'-40H		;IS IT A CONTROL-T ?
	JZ	TEMPO		;GO TO TEMPO ROUTINE
	CPI	'R'-40H		;IS IT A CONTROL-R ?
	JZ	REP		;GO TO REPEAT ROUTINE
	CPI	'J'-40H		;IS IT A CONTROL-J ?
	JZ	JOUT		;GO TO JUMP-OUT ROUTINE
	CPI	'S'-40H		;IS IT A CONTROL-S ?
	JZ	STOP		;GO TO STOP-REPEAT ROUTINE
	CPI	'R'		;IS IT AN 'R' ?
	JZ	REST		;GO TO REST ROUTINE
	MOV	B,A
	IN	01H
	CPI	'S'		;IS IT AN 'S' ?
	MOV	A,B
	JZ	LEAVE		;LEAVE MUSIC PROG
	DI
	CPI	'1'		;IS IT A '1' ? OCTAVE # SEARCH
	JC	DURA
	CPI	'7'		;IS IT A '7' ?
	JNC	DURA
	ANI	07H		;SAVE LS 3 BITS
	STA	SAVEO
	PUSH	H		;SAVE MUSIC TABLE ADDR
	CPI	04H		;IS IT THE 4TH OCTAVE
	JC	CHGLP
	LXI	H,LOOP1
	JMP	INSTR
CHGLP	LXI	H,SLOW
INSTR	SHLD	JUMP		;LOAD IN NEW JUMP ADDR
	POP	H
	RET			;RETURN TO NEXT
DURA	MVI	B,01H		;DURATION CHARACTER SEARCH
	LXI	D,ADDR1
	PUSH	D
	CPI	'W'		;IS IT A 'W' ?
	RZ
	INR	B
	CPI	'H'		;IS IT AN 'H' ?
	RZ
	INR	B
	CPI	'Q'		;IS IT A 'Q' ?
	RZ
	INR	B
	CPI	'O'		;IS IT AN 'O' ?
	RZ
	INR	B
	CPI	'S'		;IS IT AN 'S' ?
	RZ
	INR	B
	CPI	'T'		;IS IT A 'T' ?
	RET
ADDR1	JNZ	NOTE
	MOV	A,B
	STA	SAVED
	XRA	A		;ZERO ACC
	STA	SAVEF		;ERASE CONTROL-A FLAG
	RET			;RETURN TO NEXT
NOTE	MVI	B,01H		;NOTE CHARACTER SEARCH
	LXI	D,ADDR2
	PUSH	D
	CPI	'C'		;IS IT A 'C' ?
	RZ
	INR	B
	INR	B
	CPI	'D'		;IS IT A 'D' ?
	RZ
	INR	B
	INR	B
	CPI	'E'		;IS IT AN 'E' ?
	RZ
	INR	B
	CPI	'F'		;IS IT AN 'F' ?
	RZ
	INR	B
	INR	B
	CPI	'G'		;IS IT A 'G' ?
	RZ
	INR	B
	INR	B
	CPI	'A'		;IS IT AN 'A' ?
	RZ
	INR	B
	INR	B
	CPI	'B'		;IS IT A 'B' ?
	RET			;TO ADDR2
ADDR2	RNZ			;TO NEXT
	INX	H
	MOV	A,M
	CPI	'!'		;IS IT AN EXCLAMATION (FLAT) ?
	JNZ	SNOTE
	DCR	B
	JMP	STONOTE
SNOTE	CPI	'#'		;IS IT A '#' ?
	JNZ	NOTFD
	INR	B
	JMP	STONOTE
NOTFD	DCX	H
STONOTE	MOV	A,B
	STA	SAVEN
	PUSH	H
	LDA	SAVEO		;START FREQ LOOK-UP
	MOV	B,A
	LXI	H,FREQ		;1ST ADDR OF FREQ TABLE
	LXI	D,0EH		;# OF BYTES IN AN OCTAVE
BAK1	DCR	B
	JZ	GETN
	DAD	D
	JMP	BAK1
GETN	LDA	SAVEN
	MOV	E,A
	DAD	D
	MOV	A,M
	STA	FREQ1		;SAVE FREQ VALUE IN PLAY-NOTE
	MOV	B,A
	LDA	SAVEO
	CPI	04H
	MOV	A,B
	JC	LOW		;JUMP IF OCTAVE 1,2, OR 3
	SUI	04H		;SUBTRACT 4 FROM FREQ VALUE
	DB	21H		;LXI	H,
	DCR	C
	DCR	C
	JMP	STORE		;TO TWO DCR C
LOW	DCR	A
	DB	21H		;LXI	H,
	NOP			;CHANGE PLAY-NOTE INSTRUCTION
	NOP
STORE	STA	FREQ2		;TO TWO NOPS AND STORE IT
	SHLD	CHGT
OPMET	LDA	SAVET		;START TEMPO LOOK-UP
	MOV	B,A
	LXI	H,TEMPO		;1ST ADDR OF TEMPO TABLE
	LXI	D,1CH		;# OF BYTES IN AN OCTAVE
BAK2	DCR	B
	JZ	GETD
	DAD	D
	JMP	BAK2
GETD	LDA	SAVEN		;NOTE DURATION SEARCH
	RLC			;MULTIPLY BY TWO ACC
	MOV	E,A
	DAD	D
	MOV	E,M		;GET LOWER HALF OF DURATION
	INX	H
	MOV	D,M		;GET UPPER HALF OF DURATION
	LDA	SAVEO
	CMA			;CONVERT 1-6 TO 6-1
	ANI	07H
	MOV	B,A
BAK3	DCR	B
	JZ	CONT1
	CALL	DPSR		;DOUBLE PRECISION SHIFT RIGHT
	JMP	BAK3
DPSR	XRA	A		;RESET CARRY
	MOV	A,D
	RAR
	MOV	D,A
	MOV	A,E
	RAR
	MOV	E,A
	RET
CONT1	LDA	SAVED
	MOV	B,A
BAK4	DCR	B
	JZ	GETF
	CALL	DPSR
	JMP	BAK4
GETF	LDA	SAVEF
	CPI	'A'-40H		;IS IT A CONTROL 'A' ?
	LXI	H,0000H		;CLEAR HL
	JNZ	NOFG
	DAD	D		;SET HL = DE
	CALL	DPSR
NOFG	DAD	D
	XCHG			;SET DE = HL
	XRA	A		;ZERO ACC
	CMP	D		;DON'T LET D AND E = 0
	JNZ	INRD
	CMP	E
	JNZ	INRD
	INR	E
INRD	INR	D
	XCHG			;PUT DE INTO HL
	SHLD	DUR1+1
	SHLD	DUR2+1
	CALL	PLAY
	DB	21H		;LXI	H,
	OUT	PORT		;LOAD HL WITH OUTPUT INSTR
	SHLD	OUT1
	SHLD	OUT2
	POP	H		;RESTORE HL TO MUSIC TABLE
	RET			;TO NEXT
ENVEL	INX	H		;ENVELOPE ROUTINE
	MOV	A,M
	ANI	0FH
	INR	A
	STA	SAVEE
	CALL	SPENV		;CONSTRUCT SPECIAL ENVELOPE
	RET			;TO NEXT
SPENV	PUSH	H
	LXI	D,09H		;LOAD LENGTH OF ENVELOPE
	LXI	H,ENVELO	;1ST ADDR OF ENVELOPE TABLE
	LDA	SAVEE
	MOV	B,A
	BAK5	DCR	B
	JZ	CONT2
	DAD	D
	JMP	BAK5
CONT2	LXI	D,SPEC		;1ST ADDR OF SPECIAL TABLE
	LDA	SAVEV
	MOV	B,A
	MOV	C,B
	MOV	A,M		;GET ENVELOPE VALUE
BAK6	DCR	B
	JNZ	CONT3
	ORA	A		;CLEAR CARRY
	RAL
	JMP	BAK6
CONT3	STAX	D
	MOV	B,C
	INX	D
	INX	H
	MOV	A,M
	ORA	A		;SET PARITY FLAG
	JPE	CONT4
	JMP	BAK6
CONT4	POP	H
	RET
VOL	INX	H		;VOLUME ROUTINE
	MOV	A,M
	ANI	07H
	STA	SAVEV
	CALL	SPENV
	RET			;TO NEXT
TEM	INX	H		;TEMPO ROUTINE
	MOV	A,M
	ANI	07H
	STA	SAVET
	RET			;TO NEXT
	NOP
REP	INX	H		;REPEAT ROUTINE
	MOV	A,M
	ANI	0FH
	INR	A
	STA	SAVER
	SHLD	STAR
	RET			;TO NEXT
JOUT	LDA	SAVER		;JUMP OUT ROUTINE
	DCR	A
	STA	SAVER		;REPEAT # -1
	CPI	00H
	JNZ	CONT5
	LHLD	ENDT
CONT5	RET			;TO NEXT
STOP	SHLD	ENDT		;STOP-REPEAT ROUTINE
	LDA	SAVER
	DCR	A
	STA	SAVER		;REPEAT # -1
	CPI	00H
	JZ	CONT6
	LHLD	STAR
CONT6	RET			;TO NEXT
REST	PUSH	H		;REST ROUTINE
	LXI	H,0000H		;CLEAR HL
	SHLD	OUT1
	SHLD	OUT2
	JMP	OPMET
;
;	SAVE TABLE
;
SAVET	DS	1		;TEMPO #
SAVEV	DS	1		;VOLUME #
SAVEE	DS	1		;ENVELOPE #
SAVEO	DS	1		;OCTAVE #
SAVED	DS	1		;DURATION #
SAVEN	DS	1		;HALF-TONE #
SAVEF	DS	1		;CONTROL-A FLAG
SAVER	DS	1		;REPEAT #
STAR	DS	2		;STORE FOR HL
ENDT	DS	2		;STORE FOR HL
	NOP
;
;	PLAY NOTE ROUTINE
;
PLAY	LXI	H,SPEC		;START OF SPECIAL TABLE
	MVI	B,09H		;# OF SEGMENTS
	MOV	A,M
DUR1	LXI	D,016FH		;DURATION OF NOTE
LOOP2	MOV	A,A		;TIME EQUALIZER
	JMP	CYCLE		;TIME EQUALIZER
CYCLE	DB	0EH		;MVI	C,
FREQ1	DB	0A3H
OUT1	OUT	PORT
LOOP1	DCR	C
	DB	0C2H		;JNZ
JUMP	DW	LOOP1
	XRA	M
	DCR	E
	JNZ	LOOP2
	DCR	D
	JNZ	CYCLE
	ORI	00H		;TIME EQUALIZER
OUT2	OUT	PORT
	INX	H
	DCR	B
	JZ	EXIT
DUR2	LXI	D,016FH
	DB	0EH		;MVI	C,
FREQ2	DB	9FH		;TIME EQUALIZER
	CPI	00H		;EVEN-ODD CYCLE TESTER
	MVI	A,00H
	JZ	LOOP1
CHGT	DCR	C		;TIME EQUALIZER
	DCR	C		;TIME EQUALIZER
	NOP			;TIME EQUALIZER
	MOV	A,M
	JMP	LOOP1
EXIT	RET
	NOP
SLOW	PUSH	PSW
	MVI	A,02H
COUNT	DCR	A
	JNZ	COUNT
	POP	PSW
	JMP	LOOP1
;
;	TEMPO TABLE
;
;	100 BEATS PER MINUTE
TEMPO	DB	0FH,02H,2EH,02H,4FH,02H,72H,02H,98H,02H,0BFH
	DB	02H,0E9H,02H,15H,03H,44H,03H,76H,03H,0ABH
	DB	03H,0E2H,03H,1DH,04H,5CH,04H
;	125 BEATS PER MINUTE
	DB	0A5H,01H,0BFH,01H,0D9H,01H,0F5H,01H,13H,02H
	DB	033H,02H,54H,02H,77H,02H,9DH,02H,0C5H,02H,0EFH
	DB	02H,1CH,03H,4BH,03H,7DH,03H
;	150 BEATS PER MINUTE
	DB	5FH,01H,74H,01H,84H,01H,0A2H,01H,0BAH,01H
	DB	0D5H,01H,0F1H,01H,0EH,02H,2EH,02H,4FH,02H,72H
	DB	02H,97H,02H,0BEH,02H,0E8H,02H
;	SPARE TEMPO
	DB	0,0,0,0,0,0,0,0,0,0,0,0,0,0
	DB	0,0,0,0,0,0,0,0,0,0,0,0,0,0
;
;	FREQUENCY TABLE
;
;	1ST OCTAVE
FREQ	DB	0FAH,0ECH,0DFH,0D3H,0C7H,0BBH,0B1H,0A7H
	DB	9EH,95H,8CH,84H,7DH,76H
;	2ND OCTAVE
	DB	7DH,76H,6FH,69H
	DB	63H,5DH,58H,53H,4EH,4AH,46H,42H,3EH,3BH
;	3RD OCTAVE
	DB	3EH,3BH,37H,34H,31H,2EH,2CH,29H,27H,25H
	DB	23H,21H,1FH,1DH
;	4TH OCTAVE
	DB	0ADH,0A3H,99H,9DH,88H,80H
	DB	79H,72H,68H,65H,5FH,5AH,54H,50H
;	5TH OCTAVE
	DB	54H,50H,4BH,46H,42H,3EH,38H
	DB	37H,34H,31H,2EH,2BH,28H,26H
;	6TH OCTAVE
	DB	28H,26H,24H,21H,1FH,1DH,1CH
	DB	1AH,18H,17H,15H,14H,12H,11H
;
;	SPECIAL TABLE
;
SPEC	DB	07H,07H,07H,07H,07H,07H,07H,07H,00H
;
;	ENVELOPE TABLE
;
ENVELO	DB	07H,07H,07H,07H,07H,07H,07H,07H,00H	;^E-0
	DB	07H,07H,07H,07H,80H,80H,80H,80H,00H	;^E-1
	DB	07H,07H,80H,07H,07H,80H,07H,07H,00H	;^E-2
	DB	07H,86H,85H,04H,83H,02H,01H,80H,00H	;^E-3
	DB	01H,02H,83H,04H,85H,86H,07H,80H,00H	;^E-4
	DB	01H,02H,85H,07H,07H,85H,02H,01H,00H	;^E-5
	DB	0,0,0,0,0,0,0,0,0			;SPARE
	DB	0,0,0,0,0,0,0,0,0			;SPARE
	DB	0,0,0,0,0,0,0,0,0			;SPARE
	DB	0,0,0,0,0,0,0,0,0			;SPARE
;
;	MUSIC TABLE
;	START OF USER WRITTEN MUSIC
;
TABLE	DS	100
	END

