;-----------------------------------------------------------------------------
;File name:	Schedule.S			Revised:	1996.12.08
;Revised by:	Ulf Ronald Andersson		Created:	1996.12.08
;						Version:	0.1
;File purpose:	Preliminary STiK scheduler
;-----------------------------------------------------------------------------
;
;Revision history:
;
;Version:	Updates:
;  0.1		Initial creation.  Non-scheduling test version.
;
;-----------------------------------------------------------------------------
;Runtime keyboard commands:
;
; Ctrl-LShift-N  Force ST Palette colours 0, 3, 15 to white, black, black
; Ctrl-RShift-I  Force ST Palette colours 0, 3, 15 to black, white, white
;
;NB: This test version only has visible feedback in ST resolution.
;
;-----------------------------------------------------------------------------
;
	output	.TOS
;
	include	URAn_SYS.S
	include	URAn_DOS.S
	include	URAn_XB.S
	include	URAn_JAR.S
;
;-----------------------------------------------------------------------------
;
	TEXT
	opt	a+
	opt	o+
;
;-----------------------------------------------------------------------------
;
start:
	bra	install
;
;-----------------------------------------------------------------------------
;
StxS_ck:
	dc.w	$0101,$0101		;cur_vers = 1.1, I_F_vers = 1.1
	dc.l	0			;->AESPB for event generation tests
;
;-----------------------------------------------------------------------------
;
	XB_define	nu_ikbd_vec,'StxS'
	XB_donext_d	nu_ikbd_vec(pc)
	bra.s		UKEXcode
;
;-----------------------------------------------------------------------------
;
	XB_define	nu_timer,'StxS'
	move		4(sp),-(sp)	;copy argument
	XB_donext_d	nu_timer(pc)
	addq.l	#2,sp
UKEXcode:
	move	SR,-(sp)
	move.l	kb_iorec_p(pc),a0
	move	io_tail_ix(a0),d1	;tail index
	cmp	old_tail_ix(pc),d1	;test if changed
	beq.s	.return
	or	#$0700,SR
	move	io_tail_ix(a0),d1	;tail index
	move	d1,old_tail_ix		;save tail index at old_tail_ix
	cmp	io_head_ix(a0),d1
	beq.s	.return
	move.l	kbshift_p(pc),a1
	move.b	(a1),d2			;New! get kbshifts (** TOS independent **)
	and	#$0F,d2
	cmp	#6,d2			;Control + Left Shift ?
	bne.s	.return
	move.l	io_buffer_p(a0),a2	;get address of io-buffer
	move	(a2,d1),d0		;get 1'st word for this key = key code
	and	#$7F,d0
.check_ascii:
	move.l	keytbl_ptp,a2
	move.l	8(a2),a2	;a2 -> current capslock keytable
	move.b	(a2,d0),d0	;translate keycode to ascii code
	and	#$DF,d0		;enforce upper case
	cmp	#'N',d0		;Normalize palette command ?
	beq.s	.put_comd
	cmp	#'I',d0		;Invert palette command ?
	bne.s	.return
.put_comd:
	move	d0,kbd_comd
	subq	#4,d1
	bge.s	.tail_shrunk
	move	io_size_ix(a0),d1
	subq	#4,d1
.tail_shrunk:
	move	d1,io_tail_ix(a0)
	move	d1,old_tail_ix
.return:
	move	(sp)+,SR
	rts
;
;
;-----------------------------------------------------------------------------
;
	XB_define	new_time_c,'StxS'
	tst		kbd_comd
	bne.s		DOcommand
old_time_c_jmp:
	XB_gonext_d	new_time_c(pc)
;
;
DOcommand:
	tas	new_comd
	bne.s	old_time_c_jmp
	move.b	kbd_comd+1(pc),new_comd+1
	clr	kbd_comd
	push_ex	commander(pc)		;push exception frame
	bra.s	old_time_c_jmp
;
;
commander:
	movem.l	d0-d2/a0-a2,entry_regs
	move	sr,entry_sr
	ori	#$0700,sr
	bsr.s	commandsub
	move	entry_sr(pc),sr
	movem.l	entry_regs(pc),d0-d2/a0-a2
	clr	new_comd
	rte
;
;-----------------------------------------------------------------------------
;
commandsub:
	move	new_comd(pc),d0
	and	#$DF,d0			;force upper case
	cmp	#'N',d0
	beq.s	N_command
	cmp	#'I',d0
	beq.s	I_command
	bra.s	no_command
;
N_command:
	lea	(hw_pal).w,a0
	move	#$FFFF,(a0)
	clr	3*2(a0)
	clr	15*2(a0)
	rts
;
;
I_command:
	lea	(hw_pal).w,a0
	clr	(a0)
	move	#$FFFF,3*2(a0)
	move	#$FFFF,15*2(a0)
	rts
;
;
no_command:
	rts
;
;
entry_regs:	ds.l	6
entry_sr:	ds.w	1
keytbl_ptp:	dc.l	0	;-> table of 3 ptrs to keytables
kbshift_p:	dc.l	0	;-> OS variable for kbshift
kb_iorec_p:	dc.l	0	;-> keyboard iorec structure
old_tail_ix:	dc.w	-1
kbd_comd:	dc.w	0
new_comd:	dc.w	0
;
;-----------------------------------------------------------------------------
;
	_uniref	reset_old_jar
	make	JAR_links
;
;-----------------------------------------------------------------------------
;	The resident program will end here,
;	The following code only exists during installation,
;
install:
	move.l	4(sp),a5	;a5 -> basepage
	lea	pgm_len,a0
	lea	install,a1
	move.l	a1,d0
	sub.l	a5,d0		;* calculate length
	move.l	d0,(a0)
	move.l	(a0),d0
	add.l	#$1000,d0
	lea	(a5,d0.l),sp
	gemdos	Mshrink,!,(a5),d0
	xbios		Kbdvbase
	move.l		d0,a1
	XB_check	nu_ikbd_vec,32(a1)
	bpl		notagain
	XB_check	nu_timer,(etv_timer).w
	bpl		notagain
	XB_check	new_time_c,(iv_time_c).w
	bpl		notagain
	xbios	Iorec,#1
	move.l	d0,kb_iorec_p
	xbios	Keytbl,?,?,?
	move.l	d0,keytbl_ptp
	gemdos	Super,!
	lea	SSP_save,a0
	move.l	d0,(a0)
;
	make_cookie	#'StxS',StxS_ck
;
;*********; Here starts TOS identification/adaption
	move.l	(_sysbase).w,a0
	move.l	os_selfbeg_p(a0),a0
	move.l	$24(a0),a1	;->kbshift variable in modern TOS >= 1.2
	cmp	#$0102,2(a0)	;check OS version
	bhs.s	insta_OS
;this is an init of kbshift_p, valid for TOS <= TOS 1.02
	move.l	keytbl_ptp,a1
	subq	#1,a1		;NB: This assumes Kbshift stored at Keytbl-1.
;				;NB: All early TOS have Kbshift data there !!!
insta_OS:
	move.l	a1,kbshift_p
	gemdos	Super|_ind,SSP_save(pc)
	gemdos	Cconws,Activation_s(pc)
	xbios	Kbdvbase
	move.l	d0,a1		;* a1 = addr(kbdvbase)
	XB_install	nu_ikbd_vec,32(a1)
	XB_install	nu_timer,(etv_timer).w
	XB_install	new_time_c,(iv_time_c).w
	gemdos	Ptermres,pgm_len(pc),#0
;
;
notagain:
	gemdos	Cconws,Refusal_s
	gemdos	Crawcin
	gemdos	Pterm,!
;
;-----------------------------------------------------------------------------
;
	make	JAR_links
;
;-----------------------------------------------------------------------------
;
;
SSP_save:	dc.l	0
pgm_len:	dc.l	0
;
;
Activation_s:
	dc.b	CR,LF
	dc.b	"______ Schedule 0.1 activated ! ______",CR,LF
	dc.b	CR,LF
	dc.b	"<Control> <L.Shift> <N> = Norm palette",CR,LF
	dc.b	"<Control> <L.Shift> <I> = INV. palette",CR,LF
	dc.b	CR,LF
	dc.b	"--------------------------------------",CR,LF
	dc.b	"Version 0.1  developed   Dec. 1996 by:",CR,LF
	dc.b	CR,LF
	dc.b	"    Ulf Ronald Andersson",CR,LF
	dc.b	CR,LF
	dc.b	"    mailto://dlanor@oden.se",CR,LF
	dc.b	"    http://www.oden.se/~dlanor/",CR,LF
	dc.b	"--------------------------------------",CR,LF
	dc.b	NUL
;
Refusal_s:
	dc.b	CR,LF
	dc.b	"______ Schedule already active ! _____",CR,LF
	dc.b	CR,LF
	dc.b	"Sorry, I will not install Schedule,",CR,LF
	dc.b	"when it seems to be installed already.",CR,LF
	dc.b	"This should never happen, so please hit",CR,LF
	dc.b	"a key to acknowledge this warning.",CR,LF
	dc.b	"--------------------------------------",CR,LF
	dc.b	"Version 0.1   developed  Dec. 1996 by:",CR,LF
	dc.b	CR,LF
	dc.b	"    Ulf Ronald Andersson",CR,LF
	dc.b	CR,LF
	dc.b	"    mailto://dlanor@oden.se",CR,LF
	dc.b	"    http://www.oden.se/~dlanor/",CR,LF
	dc.b	"--------------------------------------",CR,LF
	dc.b	NUL
;
;
;-----------------------------------------------------------------------------
	end
;-----------------------------------------------------------------------------
;End of file:	Schedule.S
;-----------------------------------------------------------------------------
