;----------------------------------------------------------------------------
;File name:		DOUBLE2.S		Revision date:	1993.01.17
;Revision author:	Ulf Ronald Andersson
;Creative author:	Lars-Erik 0sterud	Creation date:	1991.07.02
;----------------------------------------------------------------------------
;Program purpose:	Emulate double-height screen on STE/TT
;----------------------------------------------------------------------------
;Revision purpose:	Emulate double-height screen on any ST as well
;			Add XBRA protocol to all vectors used
;----------------------------------------------------------------------------
;
color_yrez	= 440
mono_yrez	= 800
;
extra_mono	= (mono_yrez-400)*80
extra_color	= (color_yrez-200)*40
	ifne	(extra_mono>extra_color)
extra_used	= extra_mono
	elseif
extra_used	= extra_color
	endc
extra_size	= (extra_used+1023)&(-$100)+64*256
;
	include	URAn_DOS.S
	include	URAn_LA.S
	include	URAn_XB.S
;
	section	text
;
start:
	bra	install
;
;----------------------------------------------------------------------------
;	ev_vbi routine for scrolled ST/STE/TT emulation
;
	XB_define	scroll_vbl,'DubH'
	movem.l	d0-d2/d7,-(sp)		;save registers
	clr	d0
	move	screen_line(pc),d0	;d0 = line number for visible top
	move	d0,d7			;d7 = screen_line
abs_mouse_y:
	move	$face.l,d1		;d1 = mouse
imm_vstep_1:
	move	#16,d2			;d2 = margin step
imm_topmarg_1:
	add	#48,d0			;d0 = screen_line + margin
	cmp	d0,d1			;mouse >= screen_line + margin ?
	blt.s	scroll_down		;else go scroll down
imm_botmarg_1:
	add	#400-(2*48),d0		;d0 = screen_line + orig_yrez - margin			
	cmp	d0,d1			;mouse < screen_line + orig_yrez - margin ?
	bge.s	scroll_up		;else go scroll up
	movem.l	(sp)+,d0-d2/d7		;save registers
	XB_gonext_d	scroll_vbl
;
;
scroll_down:
	sub	d2,d7			;d7 = screen_line - vstep
	bge.s	set_new_pos		;d7 < 0  (over top of screen) ?
	clr	d7			;yes, set to top
	bra.s	set_new_pos
;
scroll_up:
	add	d2,d7			;d7 = screen_line + vstep
imm_y_extra_1:
	cmp	#800-400,d7		;d7 >= new_yrez-orig_yrez (past end of screen) ?
	blt.s	set_new_pos
imm_y_extra_2:
	move	#800-400,d7		;yes, set to bottom
set_new_pos:
	move	d7,screen_line		;save new position
imm_linebytes_1:
	mulu	#80,d7			;byte position
	add.l	(_v_bas_ad).w,d7		;offset for screen
	ror	#8,d7
	move.l	d7,(hw_vbase2-1).w
	movem.l	(sp)+,d0-d2/d7		;save registers
	XB_gonext_d	scroll_vbl(pc)
;
;Ends:	ev_vbi routine for scrolled ST/STE/TT emulation
;----------------------------------------------------------------------------
;	ev_vbi routine for interlaced STE/TT emulation
;
	XB_define	interlace_vbl,'DubH'
	movem.l	d0-d2/d7,-(sp)
	move.l	logical(pc),d7
	bchg	#0,screen_line
	bne.s	set_video_adr	
imm_linebytes_2:
	addi.l	#80,d7
set_video_adr:
	ror	#8,d7
	move.l	d7,(hw_vbase2-1).w	;high & mid
	ror	#8,d7
	move.b	d7,$ffff820D.w		;low (only ste)
	movem.l	(sp)+,d0-d2/d7
	XB_gonext_d	interlace_vbl(pc)
;
;Ends:	ev_vbi routine for interlaced STE/TT emulation
;----------------------------------------------------------------------------
;	ev_xgemdos routine
;
	XB_define	new_gem,'DubH'
	cmp	#$73,d0			;vdi call ?
	bne.s	go_old_gem		;no - go_old_gem
	move.l	d1,a0			;pointer to pb
	move.l	(a0),a1			;pointer to control
	cmp	#1,(a1)			;control(0)=1 ?
	bne.s	go_old_gem		;no - go_old_gem
	move.l	12(a0),imm_intout+2	;pointer to int_out
	move.l	2(sp),post_opnwk_ret+2	;real return adress
	move.l	#post_opnwk,2(sp)	;fake return adress
go_old_gem:
	XB_gonext_d	new_gem(pc)
;
;
post_opnwk:
imm_intout:
	move.l	#$face,a0		;pointer to int_out
imm_ymax_1:
	move	#800-1,la_wk_ymax-la_wk_xmax(a0)	;ymax in int_out[1]
imm_la_vars:
	move.l	#$face,a0		;linea pointer
imm_Yrez_1:
	move	#800,la_v_rez_vt(a0)	;vertical res
imm_ch_ymax_1:
	move	#25-1,la_v_cel_my(a0)	;chars height -1
imm_ymax_2:
	move	#800-1,la_wk_ymax(a0)			;ymax for line_a
	bsr.s	setup_sub
post_opnwk_ret:
	jmp	$face.l			;and to program
;
;
screen_line:	dc.w	0	;line at top of screen
screen_base:	ds.l	1	;current screen base
logical:	ds.l	1	;logical screen adress
;
;Ends:	ev_xgemdos routine
;----------------------------------------------------------------------------
;	Resident reinitialization subroutine, with data tables
;
setup_sub:
	movem.l	d0-d7/a0-a6,setup_regs
	bios	Kbshift,?
	andi.b	#3,d0			;SHIFT pressed ?
	move.b	d0,d7			;Save SHIFT status
	XB_remove	new_gem(pc),(ev_xgemdos).w
	XB_remove	scroll_vbl(pc),(ev_vbi).w
	gemdos	Super|_ind,#1
	tst	d0			;0==user  -1==super
	bne.s	.stay_super_1
	gemdos	Super,!			;d0 = entry SSP
.stay_super_1:
	move.l	d0,-(sp)		;push entry SSP or NULL
	lea	mono_data(pc),a0	;assume mono
	cmp	#2,(sshiftmd).w		;monochrome ?
	beq.s	.set_data
	lea	color_data(pc),a0	;assume color
.set_data:
	bsr	set_up_data
.continue:
	xbios	Setscreen|_ind,logical(pc),logical(pc),?
	_a_init
	move.l	a0,imm_la_vars+2
imm_Yrez_2:
	move	#800,d0
	move	d0,la_v_rez_vt(a0)		;vertical res
imm_ch_ymax_2:
	move	#800/16-1,la_v_cel_my(a0)	;chars-1
	suba.l	#-la_gcury,a0			;mouse y variable
	move.l	a0,abs_mouse_y+2		;and save adress
	XB_install	new_gem(pc),(ev_xgemdos).w
	btst	#0,d7				;Interlace mode
	bne.s	.init_interlace			;yes, install it
	XB_install	scroll_vbl(pc),(ev_vbi).w
	bra.s	exit
;
.init_interlace:
imm_linewords_1:
	move.b	#40,$FFFF820F.w		;80 bytes offset
imm_ch_ymax_3:
	XB_install	interlace_vbl(pc),(ev_vbi).w
exit:
	move.l	(sp)+,d0
	bmi.s	.stay_super_2
	gemdos	Super|_ind,d0
.stay_super_2:
	movem.l	setup_regs(pc),d0-d7/a0-a6
	rts
;
;
set_up_data:
	clr.l	d0
	move	(a0)+,d0
	move	d0,imm_Yrez_1+2
	move	d0,imm_Yrez_2+2
	subq	#1,d0
	move	d0,imm_ymax_1+2
	move	d0,imm_ymax_2+2
	addq	#1,d0
	sub	(a0)+,d0
	move	d0,imm_y_extra_1+2
	move	d0,imm_y_extra_2+2
	move	(a0)+,d0
	move	d0,imm_linebytes_1+2
	move.l	d0,imm_linebytes_2+2
	lsr	#1,d0
	move	d0,imm_linewords_1+2		;all 80 places
	move	(a0)+,imm_topmarg_1+2		;all 25 places
	move	(a0)+,imm_botmarg_1+2	;all 200-(2*25) places
	move	(a0)+,imm_vstep_1+2
	move	(a0)+,d0
	move	d0,imm_ch_ymax_1+2
	move	d0,imm_ch_ymax_2+2
	rts
;
color_data:
	dc.w	color_yrez
	dc.w	200		;original vertical rez
	dc.w	160		;bytes per line
	dc.w	24		;scroll margin (multiple of 8)
	dc.w	200-2*24	;orig Y rez - 2*(margin size)
	dc.w	8		;vertical scroll step
	dc.w	color_yrez/8-1	;max char row
;
mono_data:
	dc.w	mono_yrez
	dc.w	400		;original vertical rez
	dc.w	80		;bytes per line
	dc.w	48		;scroll margin (multiple of 16)
	dc.w	400-2*48	;orig Y rez - 2*(margin size)
	dc.w	16		;vertical scroll step
	dc.w	mono_yrez/16-1	;max char row
;
;
setup_regs:
	ds.l	15
;
;
;	End of resident routines and data
;----------------------------------------------------------------------------
;
resident_end:
;
;----------------------------------------------------------------------------
;	Routines and data below will not remain resident
;
show_info:
	lea	info_s(pc),a0
show_a0:
	gemdos	Cconws,(a0)
	rts
;
;
install:
	lea	stack(pc),sp		;set up new stack
	gemdos	Mshrink,!,start-$100,#(stack-start)+$100
	bios	Kbshift,?
	andi.b	#3,d0			;SHIFT pressed ?
	bne.s	.set_it_up		;yep, install
	bsr.s	show_info		;show info & help
	gemdos	Pterm0
;
;
.set_it_up:
	clr.b	info2_s				;skip help info
	gemdos	Super,!
	move.l	d0,-(sp)
	move.l	(_memtop).w,a4
	sub.l	#extra_size,a4	;a4 -> needed area to allocate
	gemdos	Malloc,?
	sub.l	#extra_size,d0	;everything except 32000
	bmi.s	ram_error
	gemdos	Malloc,d0
	sub.l	a3,a3		;clear initial release link
.find_it_lp:
	exg	d0,a3		;a3 -> release_chain  d0 -> old release_chain
	move.l	d0,(a3)		;a3 -> release chain -> old release_chain
	gemdos	Malloc,#extra_size
	cmp.l	d0,a4		;correct area ?
	bne.s	.find_it_lp	;else loop back to try again
	move.l	d0,(_memtop).w	;new _memtop
	move.l	d0,logical	;new logical screen
.free_chain:
	move.l	(a3),d3		;d3 = next release link
	gemdos	Mfree,(a3)	;release current area link
	move.l	d3,a3		;a3 -> next area  or is NULL
	tst.l	d3		;do any links remain ?
	bne.s	.free_chain	;if so, loop to release all of them
	gemdos	Super,()
	bsr	setup_sub
	bsr	show_info			;info text on screen
	gemdos	Ptermres,#(resident_end-start)+$100,!
;
ram_error:
	gemdos	Super,()
	bsr	show_info
	lea	ram_err_s(pc),a0
	bsr	show_a0
	gemdos	Pterm,?
;
;
;----------------------------------------------------------------------------
;
	section	data
;
info_s:
	dc.b	CR,LF,LF,ESC,'p'
	dc.b	'  ST/TT  Double-Height Emulator  1.0  ',CR,LF
	dc.b	'  (C)1993  Ulf Ronald Andersson.      ',CR,LF
	dc.b	ESC,'q',LF
info2_s:
	dc.b	'  Left  SHIFT => scrolling emulator',CR,LF
	dc.b	'  Right SHIFT => interlace emulator',CR,LF,LF
	dc.b	NUL
ram_err_s:
	dc.b	'Initialization failed: RAM conflict',CR,LF,LF,NUL
;
;----------------------------------------------------------------------------
;
	section	bss
;
	ds.l	$100	;place for program stack
stack:
;----------------------------------------------------------------------------
	end	;of file:	DOUBLE2.S