;++
;
; Test program for the MIDI port.
;
; By John Wilson.
;
; N.B. drops characters on an 11/34a under XM, but not FB.
; I suspect that .INTEN runs more code under XM and is slower.
;
; 11/11/90	JMBW	Created.
; 05/13/91	JMBW	MIDI input actually works now.
;
;--
	.mcall	.gtlin,.inten,.print,.ttyout
;
.device=emt+375
;
rcsr=	175610
rbuf=	175612
xcsr=	175614
xbuf=	175616
vec=	300
vec=310
;
comma=	',
;
start:	; prepare to crash
	mov	#jam,r0		;area
	.device			;disable ints on ^C
	; set up receive vector
	mov	#rxisr,@#vec	;addr
	mov	#340,@#vec+2
;
	mov	#100,@#rcsr	;enable ints
	tst	@#rbuf		;clear junk
	.print	#clear
;
	.rem	_
1$:	call	get		;get a char
	cmp	r0,#376
	beq	1$
	mov	r0,r1
	ash	#-6,r0
	bis	#'0,r0
	.ttyout
	mov	r1,r0
	ash	#-3,r0
	bic	#^C7,r0
	bis	#'0,r0
	.ttyout
	mov	r1,r0
	bic	#^C7,r0
	bis	#'0,r0
	.ttyout
	.ttyout	#15
	.ttyout	#12
	br	1$
.rem _ ; _

loop:	; main loop
	call	get		;get a char
10$:	cmp	r0,#220		;key-down?
	bne	loop
	mov	r0,r5		;save
	call	get		;get key #
20$:	mov	r0,r1
	call	get		;get velocity
	tst	r0		;0?
	beq	60$		;key-up
30$:	sub	#36.-1,r1	;convert valid keys to 1-49.
	bcs	loop		;never mind
	cmp	r1,#49.		;valid?
	bhi	loop
	mov	#ebuf,r4	;pt at end of buf
	mov	#'#,r0		;char
	cmp	r5,#220		;key-down?
	beq	40$		;yes
	  mov	#' ,r0		;key-up
40$:	movb	r0,-(r4)	;last char
	movb	#'H,-(r4)	;DCA command
50$:	clr	r0		;sxt
	div	#10.,r0		;divide
	bis	#'0,r1		;cvt
	movb	r1,-(r4)	;save
	mov	r0,r1		;copy
	bne	50$		;loop
	movb	#';,-(r4)	;<ESC>[;
	movb	#'[,-(r4)
	movb	#33,-(r4)
	.print	r4
	call	get		;get next
	mov	#220,r5		;; (OK?)
	tstb	r0		;cmd or data?
	bpl	20$		;data, use same command
	br	10$		;cmd, start over
60$:	clr	r5		;key-up
	br	30$		;continue
;+
;
; Get a char.
;
;-
get:	tst	len		;anything?
	beq	get		;loop if not
	clr	r0		;get empty ptr
	bisb	empty,r0
	movb	ring(r0),r0	;get char
	incb	empty		;bump ptr
	dec	len		;count char
	bic	#^C377,r0	;isolate low 8.
	rts	pc
;+
;
; Handle receive interrupts.
;
;-
rxisr:	.inten	4		;;drop to PR4
10$:	movb	@#rbuf,r4	;get char
	cmp	r4,#376		;heartbeat?
	beq	20$		;don't waste buffer space
	tstb	len+1		;will it fit?
	bne	40$		;no
	clr	r5		;get ring offset
	bisb	fill,r5
	movb	r4,ring(r5)	;save char
	incb	fill
	inc	len		;count it
20$:	; poll for more
	tstb	@#rcsr		;more?
	bmi	10$		;yes
	rts	pc
30$:	; just lose if the queue is full
	tst	@#rbuf		;flush
40$:	tstb	@#rcsr		;more?
	bmi	30$		;yes, flush it
	rts	pc
;
clear:	.ascii	<33>/</<33>/[H/<33>/[J/<200>
	.even
;
jam:	.byte	0,14		;.DEVICE, non-linking
	.word	.+2
	.word	rcsr,0		;0 => RCSR
	.word	0,0
;
	.blkb	7		;<ESC>[;nnHc
ebuf:	.byte	15,200		;end of string
	.even
;
ring:	.blkb	400
fill:	.byte	0
empty:	.byte	0
len:	.word	0
;
	.end	start