;----------------------------------------------------------------------------
;File name:	TEST_KB.S		Revision date:	1993.07.30
;Creator:	Ulf Ronald Andersson	Creation date:	1993.07.29
;(c)1993 by:	Ulf Ronald Andersson	All rights reserved
;----------------------------------------------------------------------------
;
	output	.TOS
;
	include	URAn_APP.S
	include	URAn_KEY.S
;
;----------------------------------------------------------------------------
		data
;
acc_name:	dc.b	'  Test KB',0
		even
;
;----------------------------------------------------------------------------
		bss
;
mystack_data:	ds.l	$100
mystack:	ds.w	1	;User defined stack (goes backwards).
message:	ds.b	16	;Message pipe.
intin:		ds.w	30
intout:		ds.w	45
ptsin:		ds.w	30
ptsout:		ds.w	12
;
;----------------------------------------------------------------------------
		text
;
init_app:
	tst	d7
	bmi.s	.TOS_init
	nop
.TOS_init:
	gemdos	Super,!
	move.l	d0,-(sp)
	xbios	Keytbl,?,?,?
	move.l	d0,a0
	lea	-1(a0),a0	;NB: this assumes Kbshift stored at Keytbl-1
	move.l	a0,kbshift_p	;NB: So all early TOS have Kbshift data at Keytbl-1 !!!
	move.l	(_sysbase).w,a1
	move.l	os_selfbeg_p(a1),a0
	move	os_version(a0),d0
	cmp	#$104,d0
	blo.s	.done_kbshift_p
	move.l	os_kbshift_p(a0),kbshift_p
.done_kbshift_p:
	gemdos	Super,()
	rts
;
;
exec_app:
	tst	d7
	bpl.s	GEM_app
        nop
	clr	d4
TOS_app:
GEM_app:
	gemdos	Cconws,helptext_s(pc)
.nextchar:
	move.l	lastchar(pc),prevchar
	gemdos	Cconout,#CR
	gemdos	Cconout,#LF
	gemdos	Crawcin
;;;	gen_key
	move.l	d0,lastchar
	move.l	kbshift_p(pc),a0
	move.b	(a0),kbshifts
	gemdos	Cconws,kbshifts_s(pc)
	clr.l	d0
	move.b	kbshifts(pc),d0
	bsr.s	displong
	gemdos	Cconws,crlf_s(pc)
	gemdos	Cconws,kb_value_s(pc)
	move.l	lastchar,d0
	bsr.s	displong
	gemdos	Cconout,#$20
	move.l	lastchar,d0
	bsr.s	dispchar
	move.l	lastchar,d0
	cmp.b	#CR,d0
	bne	.nextchar
	cmp.b	prevchar+3,d0
	bne	.nextchar
	gemdos	Cconws,crlf_s(pc)
	clr.l	d0
	rts
;
;
displong:
	bsr	.dispword
.dispword:
	bsr	.dispbyte
.dispbyte:
	move.l	d0,-(sp)
	gemdos	Cconout,#$20
	move.l	(sp)+,d0
	bsr	.disp_hex
.disp_hex:
	rol.l	#4,d0
	movem.l	d0-d2/a0-a2,-(sp)
	and	#$0F,d0
	or	#'0',d0
	cmp	#'9',d0
	bls.s	.got_hex
	add	#('A'-('9'+1)),d0
.got_hex:
	gemdos	Cconout,d0
	movem.l	(sp)+,d0-d2/a0-a2
	rts
;
;
dispchar:
	move.l	d0,-(sp)
	bios	bconout,#5,d0
	move.l	(sp)+,d0
	rts
;
;
	make	KEY_links
;
;
kbshifts:	dc.w	0
prevchar:	dc.l	0
lastchar:	dc.l	0
;
kbshifts_s:
	dc.b	'Kbshifts = '
	dc.b	NUL
;
kb_value_s
	dc.b	'Kb_value = '
	dc.b	NUL
;
helptext_s:
	dc.b	CR,LF
	dc.b	'Type [Return] twice to exit program.'
crlf_s:
	dc.b	CR,LF
	dc.b	NUL
	even
;
;
;----------------------------------------------------------------------------
	END	;of:	TEST_KB.S
;----------------------------------------------------------------------------
