;----------------------------------------------------------------------------
;File name:	F_OLD.S			Revision date:	1995.08.08
;Creator:	Ulf Ronald Andersson	Creation date:	1995.07.26
;(c)1992 by:	Ulf Ronald Andersson	All rights reserved
;Released as:	FREEWARE		(NB: commercial sales forbidden!)
;----------------------------------------------------------------------------
;
	output	.GTP
;
;----------------------------------------------------------------------------
	include	URAn_SIM.S
	include	URAn_JAR.S
	include	URAn_XB.S
	include	URAn_LA.S
;----------------------------------------------------------------------------
	SECTION	text
;----------------------------------------------------------------------------
;
	bra	startup
	illegal
;
;----------------------------------------------------------------------------
;
stackframe_len:		ds.w	1
err_code:		ds.l	1
os_basepage_p:		ds.l	1
tos_sr:			ds.w	1
tos_regs:		ds.l	16
FBoo_struct:
FBoo_version:		dc.w	$0100
FBoo_interface:		dc.w	$0100
font_bas_p:		dc.l	font_base
font_end_p:		dc.l	font_base
font_lim_p:		dc.l	font_limit
old_font_t:		ds.l	4
new_font_t:		ds.l	4
use_font_t:		ds.l	4
fix_font_p:		dc.l	fix_fonts
;
font_base:		ds.b	24*1024
font_limit:
;
;----------------------------------------------------------------------------
;
;
;----------------------------------------------------------------------------
;
	XB_define	nu_exec_os,'FBoo'
	move.l	4(sp),os_basepage_p
	movem.l	d0-d7/a0-a6,-(sp)
	xbios	Supexec,fix_fonts
	movem.l	(sp)+,d0-d7/a0-a6
	XB_gonext_d	nu_exec_os	;start desktop
;
;----------------------------------------------------------------------------
;		XGEMDOS functions with XBRA
;----------------------------------------------------------------------------
;
	XB_define	nu_xgemdos,'FBoo'
try_VDI:
	cmpi	#$73,d0			;VDI call ?
	bne.s	try_AES			;if not VDI, it may be AES
	move.l	d1,a0			;a0->vdipb
	move.l	(a0),a0			;a0->contrl
;
	cmp	#v_clswk&$ff,(a0)
	bhi.s	go_old_xgemdos
	beq	nu_v_clswk
	cmp	#v_opnwk&$ff,(a0)
	beq.s	nu_v_opnwk
go_old_xgemdos:
	move.l	nu_xgemdos+xb_next(pc),a0
	jmp	(a0)
;
try_AES:
	cmpi	#$C8,d0			;AES call ?
	bne.s	go_old_xgemdos
	move.l	d1,a0			;a0->aespb
	move.l	(a0),a0			;a0->contrl
;
	cmp	#appl_init&$ff,(a0)
	bne.s	go_old_xgemdos
nu_appl_init:
	move	sr,-(sp)
	ori	#$0700,sr
	move	(sp)+,tos_sr
	movem.l	d0-d7/a0-a6,tos_regs
	bsr	fix_fonts		;fix fonts before appl_init
	movem.l	tos_regs,d0-d7/a0-a6
	move	tos_sr(pc),sr
	bra.s	go_old_xgemdos
	
;
;-------------------------------------
;
nu_v_opnwk:
	move.l	d1,a0			;a0->vdipb
	move.l	4(a0),a0		;a0->intin
	cmp	#10,(a0)		;device < 10 ? (2..4/5..9 == rez 0..2/3..7)
	bhs	go_old_xgemdos		;else go old GEM (probably GDOS)
;
	tst	(_longframe).w		;\
	beq.s	.done_frame		; \
	clr	-(sp)			;  \/ Push a simulated
.done_frame:				;  /\ exception stack frame
	pea	.end_v_opnwk		; /
	move	sr,-(sp)		;/
;
	move	sr,-(sp)
	ori	#$0700,sr
	move	(sp)+,tos_sr
	movem.l	d0-d7/a0-a6,tos_regs
	bsr	fix_fonts		;fix fonts before v_opnwk
;;;		lea	(ev_gemdos).w,a0
;;;		lea	nu_gemdos(pc),a1
;;;		bsr	install_XB
	movem.l	tos_regs,d0-d7/a0-a6
	move	tos_sr(pc),sr
;
	move.l	nu_xgemdos+xb_next(pc),a0
	jmp	(a0)
;
;-------------------------------------
;
.end_v_opnwk:
	move	sr,-(sp)
	ori	#$0700,sr
	move	(sp)+,tos_sr
	movem.l	d0-d7/a0-a6,tos_regs
	bsr	fix_fonts		;fix fonts after v_opnwk
	movem.l	tos_regs,d0-d7/a0-a6
	move	tos_sr(pc),sr
	rte
;
;-------------------------------------
;
nu_v_clswk:		;closing workstation
	move.l	nu_xgemdos+xb_next(pc),a0
	jmp	(a0)
;
;----------------------------------------------------------------------------
;End of:	XGEMDOS functions with XBRA
;----------------------------------------------------------------------------
;		GEMDOS functions with XBRA
;----------------------------------------------------------------------------
;
	XB_define	nu_gemdos,'FBoo'
	move.l	sp,a0
	adda	stackframe_len(pc),a0
	btst	#5,(sp)
	bne.s	.keep_args_a0
	move	USP,a0
.keep_args_a0:
	cmp	#Pexec&$FF,(a0)		;Pexec ?
	bne.s	go_old_gemdos
;
nu_pexec:
	move	sr,d0
	or	#$0700,SR
	movem.l	d0-d7/a0-a6,tos_regs
	bsr	fix_fonts		;fix fonts before Pexec
	movem.l	tos_regs(pc),d0-d7/a0-a6
	move	d0,sr
go_old_gemdos:
	move.l	nu_gemdos+xb_next(pc),a0
	jmp	(a0)
;
;----------------------------------------------------------------------------
;End of:	GEMDOS functions with XBRA
;----------------------------------------------------------------------------
;		XBIOS functions with XBRA
;----------------------------------------------------------------------------
;
	XB_define	nu_xbios,'FBoo'
	move.l	sp,a0
	adda	stackframe_len(pc),a0
	btst	#5,(sp)
	bne.s	.keep_args_a0
	move	USP,a0
.keep_args_a0:
	cmp	#Setscreen&$FF,(a0)
	bne.s	go_old_xbios		;skip fix_font except for Setscreen
;
nu_setscreen:
	tst	10(a0)
	bmi.s	go_old_xbios		;skip fix_font if rez unaffected
;
	move	10(a0),-(sp)		;push copy of rez arg
	move.l	6(a0),-(sp)		;push copy of physbase arg
	move.l	2(a0),-(sp)		;push copy of logbase arg
	move	#Setscreen&$ff,-(sp)	;Push copy of function code arg
;
	tst	(_longframe).w		;\
	beq.s	.done_frame		; \
	clr	-(sp)			;  \/ Push a simulated
.done_frame:				;  /\ exception stack frame
	pea	end_setscreen(pc)	; /
	move	sr,-(sp)		;/
;
	move	sr,-(sp)
	ori	#$0700,sr
	move	(sp)+,tos_sr
	movem.l	d0-d7/a0-a6,tos_regs
	bsr	fix_fonts		;fix fonts before Setscreen
	movem.l	tos_regs(pc),d0-d7/a0-a6
	move	tos_sr(pc),sr
;
go_old_xbios:
	move.l	nu_xbios+xb_next(pc),a0
	jmp	(a0)
;
;-------------------------------------
;
end_setscreen:
	add	#12,sp			;pop argument copies off stack
	move	sr,-(sp)
	ori	#$0700,sr
	move	(sp)+,tos_sr
	movem.l	d0-d7/a0-a6,tos_regs
	bsr	fix_fonts		;fix fonts after Setscreen
	movem.l	tos_regs(pc),d0-d7/a0-a6
	move	tos_sr(pc),sr
	rte
;
;
;----------------------------------------------------------------------------
;End of:	XBIOS functions with XBRA
;----------------------------------------------------------------------------
;Start of:	Supexec subroutine	'remove_XB'
;----------------------------------------------------------------------------
;entry:	a0 -> XBRA chain root
;  "	d0 =  XBRA id
;exit:	a0 = used link/garbage/garbage  \/ depending on
;  "	d0 = 0/E_FILNF/E_SEEK (flagged) /\ success/unfound/vector_smash
;
remove_XB:
	movem.l	a1,-(sp)
.loop:
	move.l	(a0),a1			;a1 -> xb_code of next vector
	lea	-xb_code(a1),a1		;a1 -> XBRA structure
	cmp.l	#'XBRA',xb_magic(a1)
	bne.s	.smashed
	cmp.l	xb_id(a1),d0
	beq.s	.found
	lea	xb_next(a1),a0		;a0 -> xb_next -> next xb_code
	tst.l	(a0)
	bgt.s	.loop
.unused:
	moveq	#E_SEEK,d0
	bra.s	.exit
;
.smashed:
	moveq	#E_CRC,d0
	bra.s	.exit
;
.found:
	move.l	xb_next(a1),(a0)
	moveq	#E_OK,d0
.exit:
	movem.l	(sp)+,a1
	rts
;
;----------------------------------------------------------------------------
;End of:	Supexec subroutine	'remove_XB'
;----------------------------------------------------------------------------
;Start of:	Supexec subroutine	'install_XB'
;----------------------------------------------------------------------------
;entry:	a0 -> XBRA chain root
;  "	a1 -> XBRA structure to install
;exit:	a0 = used link/garbage/garbage  \/ depending on
;  "	d0 = 0/E_ACCDN/E_SEEK (flagged) /\ success/conflict/vector_smash
;
install_XB:
	movem.l	a1-a3,-(sp)
	move	sr,-(sp)
	ori	#$0700,sr
	move.l	a0,a3
	move.l	xb_id(a1),d0
.loop:
	move.l	(a0),a2			;a2 -> xb_code of next vector
	lea	-xb_code(a2),a2		;a2 -> XBRA structure
	cmp.l	#'XBRA',xb_magic(a2)
	bne.s	.smashed
	cmp.l	xb_id(a2),d0
	beq.s	.found
	lea	xb_next(a2),a0		;a0 -> xb_next -> next xb_code
	tst.l	(a0)
	bgt.s	.loop
.unused:
.smashed:
	move.l	a3,a0
	move.l	(a0),xb_next(a1)
	lea	xb_code(a1),a1
	move.l	a1,(a0)
	moveq	#E_OK,d0
	bra.s	.exit
;
.found:
	moveq	#E_ACCDN,d0
.exit:
	move	(sp)+,sr
	tst.l	d0
	movem.l	(sp)+,a1-a3
	rts
;
;----------------------------------------------------------------------------
;End of:	Supexec subroutine	'install_XB'
;----------------------------------------------------------------------------
;Start of:	Supexec subroutine	'find_old_fonts'
;----------------------------------------------------------------------------
;
find_old_fonts:
	move	sr,d0			;d0 = interrupt mask
	ori	#$0700,sr		;disable interrupts
;
	_a_init
	lea	old_font_t(pc),a1
	move.l	la_def_font(a0),(a1)+	;store -> old default font
	move.l	la_font_ring(a0),(a1)+	;store -> old small font
	move.l	la_font_ring+4(a0),a0
	move.l	a0,(a1)+		;store -> old medium font
	move.l	fnt_next(a0),(a1)+	;store -> old large font
;	
	move	d0,sr			;restore interrupt mask
	rts
;
;----------------------------------------------------------------------------
;End of:	Supexec subroutine 	'find_old_fonts'
;----------------------------------------------------------------------------
;Start of:	Supexec subroutine	'fix_fonts'
;----------------------------------------------------------------------------
;
fix_fonts:
	_a_init
	lea	use_font_t(pc),a4	;a4 -> new font pointers
	move	sr,d5			;d5 = interrupt mask
	ori	#$0700,sr		;disable interrupts
	move.l	la_def_font(a0),a3	;a3 -> current default font
	move.l	a3,d3			;d3 -> original default font
;
	move.l	la_font_ring(a0),a2	;a2 -> old Small font
	move.l	a2,a1			;a1 -> old small font
	tst.l	4(a4)
	beq.s	.done_small_font
	move.l	4(a4),a1		;a1 -> new Small font
	cmp.l	a1,a2			;are these identical ?
	beq.s	.done_small_font
	move	#1,fnt_id(a1)
	move.l	fnt_next(a2),fnt_next(a1)
	move.l	a1,la_font_ring(a0)	;activate new small font
.done_small_font:
	move.l	a1,4(a4)		;store used small font
;
	move.l	la_font_ring+4(a0),a2	;a2 -> old Medium font
	move.l	a2,a1			;a1 -> old medium font
	tst.l	8(a4)
	beq.s	.done_medium_font
	move.l	8(a4),a1		;a1 -> new Medium font
	cmp.l	a1,a2			;are these identical ?
	beq.s	.done_medium_font
	move	#1,fnt_id(a1)
	move.l	fnt_next(a2),fnt_next(a1)
	bclr	#0,fnt_flag+1(a1)
	btst	#0,fnt_flag+1(a2)
	beq.s	.done_medium_flag
	bset	#0,fnt_flag+1(a1)
.done_medium_flag:
	move.l	a1,la_font_ring+4(a0)	;activate new medium font
	cmp.l	a2,a3			;was medium font default ?
	bne.s	.done_medium_font
;;;		move.l	a1,a3			;\/ make new medium font
;;;		move.l	a1,la_def_font(a0)	;/\ default font
.done_medium_font:
	move.l	a1,8(a4)		;store used medium font
;
	move.l	la_font_ring+4(a0),a2	;a2 -> Medium font
	move.l	fnt_next(a2),a2		;a2 -> old Large font
	move.l	a2,a1			;a1 -> old large font
	tst.l	12(a4)
	beq.s	.done_large_font
	move.l	12(a4),a1		;a1 -> new Large font
	cmp.l	a1,a2			;are these identical ?
	beq.s	.done_large_font
	move	#1,fnt_id(a1)
	move.l	fnt_next(a2),fnt_next(a1)
	bclr	#0,fnt_flag+1(a1)
	btst	#0,fnt_flag+1(a2)
	beq.s	.done_large_flag
	bset	#0,fnt_flag+1(a1)
.done_large_flag:
	move.l	a2,d2			;d2 -> old large font
	move.l	la_font_ring+4(a0),a2	;a2 -> Medium font
	move.l	a1,fnt_next(a2)		;link new Large font
	cmp.l	d2,a3			;was large font default ?
	bne.s	.done_large_font
;;;		move.l	a1,a3			;\/ make new large font
;;;		move.l	a1,la_def_font(a0)	;/\ default font
.done_large_font:
	move.l	a1,12(a4)		;store used large font
;
	move.l	a3,(a4)			;store used default font
;;;		move.l	a3,la_cur_font(a0)	;make current font = default
	bra	.done_default	;;;patch
;
	cmp.l	a3,d3			;default font changed ?
;;;		beq	.done_default	;;;patch
	move.l	la_def_font(a0),a1
;
	move	fnt_fheight(a1),la_v_cel_ht(a0)
;
	clr.l	d1
	move	la_v_rez_vt(a0),d1
	divu	la_v_cel_ht(a0),d1
	subq	#1,d1
	move	d1,la_v_cel_my(a0)
	move	la_bytes_lin(a0),d1
	mulu	la_v_cel_ht(a0),d1
	move	d1,la_v_cel_wr(a0)
;
	clr.l	d1
	move	la_v_rez_hz(a0),d1
	divu	fnt_cellw(a1),d1
	subq	#1,d1
	move	d1,la_v_cel_mx(a0)
;patch
	move.l	la_v_cur_ad(a0),d1
	sub.l	(_v_bas_ad).w,d1
	divu	la_v_cel_wr(a0),d1
	cmp	la_v_cel_my(a0),d1
	bls.s	.good_y
	move	la_v_cel_my(a0),d1
.good_y:
	move	la_v_cur_xy(a0),d0
	cmp	la_v_cel_mx(a0),d0
	bls.s	.good_x
	move	la_v_cel_mx(a0),d0
.good_x:
	movem	d0/d1,la_v_cur_xy(a0)
;fix la_v_cur_ad
	move	la_v_cur_xy(a0),d0	;d0 = column
	mulu	fnt_cellw(a1),d0	;d0 = X coord
	move	d0,la_destx(a0)		;store X coord for next screen char
	divu	#16,d0			;d0 = word index in mono line
	move	la_planes(a0),d1
	mulu	d0,d1			;d1 = word index in real line
	add	d1,d1			;d1 = byte offset of real line word
	swap	d0			;d0 = bit index in word
	lsr	#3,d0			;d0 = byte index in word
	add	d0,d1			;d1 = byte offset in line
	move	la_v_cur_xy+2(a0),d0	;d0 = row
	mulu	la_v_cel_wr(a0),d0	;d0 = row byte offset
	add.l	d0,d1			;d1 = byte offset of character
	clr.l	d0
	move	la_v_cur_of(a0),d0
	add.l	d0,d1			;d1 = adj byte offset
	add.l	(_v_bas_ad).w,d1	;d1 -> screen byte
	move.l	d1,la_v_cur_ad(a0)	;store screen adr of text cursor
;
	move	la_v_cur_xy+2(a0),d0	;d0 = row
	mulu	la_v_cel_ht(a0),d0	;d0 = Y coord
	move	d0,la_desty		;store Y coord of next screen char
;
	move	#1,la_mono(a0)
	move	fnt_cellw(a1),la_delx(a0)
	move	fnt_fheight(a1),la_dely(a0)
	move	fnt_fbase(a1),la_fbase(a0)
	move	fnt_fwidth(a1),la_fwidth(a0)
	move	fnt_litemask(a1),la_litemask(a0)
	move	fnt_skewmask(a1),la_skewmask(a0)
	move	fnt_weight(a1),la_weight(a0)
	move	fnt_roff(a1),la_roff(a0)
	move	fnt_loff(a1),la_loff(a0)
;
	move.l	fnt_fbase(a1),la_v_fnt_ad(a0)
	move.l	fnt_chr_tp(a1),la_v_off_ad(a0)
	move	fnt_fwidth(a1),la_v_fnt_wd(a0)
	move	fnt_hasc(a1),la_v_fnt_nd(A0)
	move	fnt_lasc(a1),la_v_fnt_st(A0)
;
.done_default:
	move.l	4(a4),a1
	move	fnt_charw(a1),la_siz_tab+0(a0)
	move	fnt_dtop(a1),la_siz_tab+2(a0)
	move.l	12(a4),a1
	move	fnt_charw(a1),la_siz_tab+4(a0)
	move	fnt_dtop(a1),la_siz_tab+6(a0)
.done_font_fix:
	move	d5,sr			;restore interrupt mask
	rts
;
;----------------------------------------------------------------------------
;End of:	Supexec subroutine 	'fix_fonts'
;----------------------------------------------------------------------------
;	Resident library routines
;
	make	SIM_links
;
	_uniref	reset_old_jar
	make	JAR_links
;
resident_end:	;All code below is non-resident
;
;----------------------------------------------------------------------------
;Start of:	non-resident installation routines
;----------------------------------------------------------------------------
;
startup:
	include	URAn_APP.S
;
;----------------------------------------------------------------------------
;
init_app:
	include	URAN_ARG.S
	tst	acc_flag
	bne.s	exec_app
	xbios	Supexec,try_install
	rts
;
;----------------------------------------------------------------------------
;
exec_app:
	move.l	err_code(pc),d0
	bmi	error_d0
	move.l	arg_ptr(pc),a4	;a4 = arg_ptr
	move	arg_cnt(pc),d0	;d0 = arg_cnt
	move	d0,d5
	subq	#1,d5
	bgt.s	.have_args
	lea	default_arg_t(pc),a4	;a4 -> 3 font number/name pairs
	moveq	#6,d5			;d5 = number of arguments
.have_args:
	cmp	#8,d5
	bhi	usage_error
	btst	#0,d5
	bne	usage_error		;arguments must be paired !
	xbios	Supexec,find_old_fonts
	lsr	#1,d5			;we use 2 args/loop
	subq	#1,d5			;prep for dbra
.loop_1:
	tst.b	(a4)+			;pass arg 0 (progname or dummy)
	bne.s	.loop_1
	lea	font_base(pc),a3		;a3 -> first font buffer
main_loop:			;conversion process for each argument font_file
	bsr	eval_num
	bmi	usage_error
	cmp	#4,d0
	bhs	usage_error
	move	d0,current_code
	lea	fontpath_s(pc),a0
.loop_2:
	move.b	(a4)+,(a0)+
	bne.s	.loop_2
	gemdos	Fopen,fontpath_s(pc),!
	move.l	d0,d7
	bmi	open_error
	gemdos	Fseek,!,d7,!
	tst.l	d0
	bmi	read_error
	gemdos	Fread,d7,#$58,(a3)
	move.l	d0,d6
	bmi	read_error
	cmp	#$58,d6
	bne	font_error
	lea	(a3),a0			;a0 -> base of current font
	move.l	fnt_chr_tp(a0),d4
	move.l	fnt_hor_tp(a0),d3
	move	fnt_hasc(a0),d2
	move	fnt_lasc(a0),d1
	move	fnt_flag(a0),d0
	btst	#2,d0
	bne.s	.flag_is_68000
	rol	#8,d0			;reverse bytes of fnt_flag
	btst	#2,d0
	bne	font_error		;flags 68000 mode in Intel format !!!
.flag_is_intel:				;flag is legal intel flag, in motorola format
	rol	#8,d1	;reverse bytes of fnt_lasc
	rol	#8,d2	;reverse bytes of fnt_hasc
	rol	#8,d3	;\
	swap	d3	; X Reverse bytes of fnt_hor_tp
	rol	#8,d3	;/
	rol	#8,d4	;\
	swap	d4	; X Reverse bytes of fnt_chr_tp
	rol	#8,d4	;/
.flag_is_68000:				;flag has 68000 format, but retains correct mode flag
	move.l	d4,font_chr_tp
	move.l	d3,font_hor_tp
	move	d2,font_hasc
	move	d1,font_lasc
	move	d0,font_flag
	move	font_hasc(pc),d0
	sub	font_lasc(pc),d0
	blt	font_error
	cmp	#255,d0
	bgt	font_error
	addq	#1,d0		;d0 = total characters in font
	move	d0,font_size
	btst	#2,font_flag+1(pc)
	bne.s	.keep_68000_order
	move	(a0),d0		;\
	rol	#8,d0		; X Reverse bytes of fnt_id
	move	d0,(a0)+	;/
	move	(a0),d0		;\
	rol	#8,d0		; X Reverse bytes of fnt_pts
	move	d0,(a0)+	;/
	lea	32(a0),a0	; Pass fnt_name unchanged
	moveq	#(fnt_next+4-fnt_lasc)/2-1,d1	;prep d1 for dbra loop for the rest
.fixloop_1:
	move	(a0),d0		;\
	rol	#8,d0		; X Reverse bytes of another word
	move	d0,(a0)+	;/
	dbra	d1,.fixloop_1
	lea	(a3),a0			;a0 -> base of current font
	move.l	fnt_hor_tp(a0),d0	;\
	swap	d0			; X Reverse words of fnt_hor_tp
	move.l	d0,fnt_hor_tp(a0)	;/
	move.l	fnt_chr_tp(a0),d0	;\
	swap	d0			; X Reverse words of fnt_chr_tp
	move.l	d0,fnt_chr_tp(a0)	;/
	move.l	fnt_fbase(a0),d0	;\
	swap	d0			; X Reverse words of fnt_fbase
	move.l	d0,fnt_fbase(a0)	;/
	move.l	fnt_next(a0),d0		;\
	swap	d0			; X Reverse words of fnt_next
	move.l	d0,fnt_next(a0)		;/
.keep_68000_order:
	move	font_flag(pc),d0
	move.l	font_chr_tp(pc),d1
	cmp.l	font_hor_tp(pc),d1
	bne.s	.keep_horoff
	bclr	#1,d0		;remove erroneous horoff flag
.keep_horoff:
	move	d0,font_flag
	bset	#2,d0		;enforce 68000 flag
	move	d0,fnt_flag(a0) ;in the header
;
; Here fonthead_t is mostly converted, only 4 ptrs remain to be fixed
;
	gemdos	Fseek,font_chr_tp,d7,!
	tst.l	d0
	bmi	read_error
	clr.l	d3
	move	font_size(pc),d3
	addq	#1,d3			;chr_tp table needs 1 more entry
	add	d3,d3			;and each entry uses 2 bytes
	gemdos	Fread,d7,d3,$58(a3)
	cmp.l	d3,d0
	bne	font_error
	moveq	#$58,d1
	lea	(a3,d1),a0		;a0 -> chr_off table
	move.l	a0,fnt_chr_tp(a3)	;fnt_chr_tp is completed !
	add.l	d1,d0
	move.l	fnt_fbase(a3),font_fbase
	lea	(a3,d0),a0		;a0 -> fontdata
	move.l	a0,fnt_fbase(a3)	;fnt_fbase is completed
;
	btst	#2,font_flag+1(pc)
	bne.s	.keep_chr_off
	lea	(a3,d1),a0		;a0 -> chr_off table
	move	font_size(pc),d1	;d1 =  entry_count - 1
.fixloop_2:
	move	(a0),d0		;\
	rol	#8,d0		; X Reverse another chr_off word
	move	d0,(a0)+	;/
	dbra	d1,.fixloop_2
.keep_chr_off:
;
; Here chr_off_t is completely converted and ready for use
;
	bclr	#1,font_flag+1		;hor_off table present ?
	beq.s	converted
	clr.l	d3
	move	font_size(pc),d3	;d3 = entry count for hor_tp table
	add	d3,d3			;and each entry uses 2 bytes
	add.l	font_hor_tp(pc),d3	;d3 = offset to fontdata in file
	gemdos	Fseek,d3,d7,!
	tst.l	d0
	bmi	read_error
	clr.l	fnt_hor_tp(a3)		;fnt_hor_tp is completed
;
; Here hor_off_t is completely eliminated
;
converted:
;
; Now we must read fontdata
;
	gemdos	Fseek,font_fbase(pc),d7,!
	tst.l	d0
	bmi	read_error
	move	fnt_fwidth(a3),d3
	mulu	fnt_fheight(a3),d3
	gemdos	Fread|_ind,d7,d3,fnt_fbase(a3)
	cmp.l	d3,d0
	bne.s	read_error
	clr.l	fnt_next(a3)
	gemdos	Fclose,d7
;
; Here the entire current font is completed, and ready for insertion
; but that will be done later, here we just save the pointer
;
	move	current_code(pc),d0
	asl	#2,d0
	lea	new_font_t(pc),a0
	move.l	a3,(a0,d0)
;
; Here we repatch some header data for special cases
;
;;;		bset	#0,fnt_flag+1(a3)	;;;patch
;
	move.l	fnt_fbase(a3),a3
	add.l	d3,a3			;a3 -> base for next font
;
open_error:
completed:
	dbra	d5,main_loop	;loop back for more fonts
	move.l	a3,font_end_p
	lea	new_font_t+4(pc),a0
	lea	use_font_t+4(pc),a1
	move.l	(a0)+,(a1)+
	move.l	(a0)+,(a1)+
	move.l	(a0)+,(a1)+
;
	xbios	Supexec,fix_fonts
;
	clr.l	d0
	tst	acc_flag
	bne.s	good_exit
resident_exit:
	move.l	#resident_end,d1
	sub.l	basepage_p(pc),d1
	move.l	#$ADD1,d0
good_exit:
	rts
;
font_error:
read_error:
	move.l	d0,d6
	gemdos	Fseek,!,d7,#2
	gemdos	Fclose,d7
test_error:
	move.l	d6,d0
	bmi.s	error_d0
general_error:
	moveq	#-1,d0
error_d0:
	move.l	d0,d6
	sim_aes	form_alert,#1,error_alert_s(pc)
	move.l	d6,d0
	rts
;
usage_error:
	sim_aes	form_alert,#1,usage_alert_s(pc)
	moveq	#-1,d0
	rts
;
;----------------------------------------------------------------------------
;
eval_num:
	move.l	d1,-(sp)
	clr	d1
	clr.l	d0
.loop:
	move.b	(a4)+,d1
	beq.s	.exit
	sub	#'0',d1
	blo.s	.error
	cmp	#9,d1
	bhi.s	.error
	mulu	#10,d0
	add	d1,d0
	bra.s	.loop
;
.error:
	moveq	#-1,d0
.exit:
	movem.l	(sp)+,d1
	rts
;
;----------------------------------------------------------------------------
;
try_install:
;
	move.l	(ev_trap5).w,a0
	move.l	#.do_trap,(ev_trap5).w
	move.l	sp,d0
	trap	#5				;process exception at .do_trap
.do_trap:
	sub.l	sp,d0			;d0 = frame size
	add	d0,sp			;sp = pre_exception SSP
	move	d0,stackframe_len
	move.l	a0,(ev_trap5).w		;restore original trap5_handler
;
	make_cookie	#'FBoo',#FBoo_struct
;
	lea	(ev_xbios).w,a0
	lea	nu_xbios(pc),a1
	bsr	install_XB
	move.l	d0,err_code
;
	lea	(ev_gemdos).w,a0
	lea	nu_gemdos(pc),a1
;;;	bsr	install_XB
;;;	move.l	d0,err_code
;
	lea	(ev_xgemdos).w,a0
	lea	nu_xgemdos(pc),a1
	bsr	install_XB
	move.l	d0,err_code
	bmi.s	.exit
;
	lea	(exec_os).w,a0
	lea	nu_exec_os(pc),a1
	bsr	install_XB
	move.l	d0,err_code
;
.exit:
	rts
;
;----------------------------------------------------------------------------
;
	make	SIM_links
	make	JAR_links
;
;----------------------------------------------------------------------------
	SECTION	data
;----------------------------------------------------------------------------
;
acc_name:	dc.b	'  F_BOOT is no ACC !',NUL
crlf_s:		dc.b	CR,LF,NUL
	even
;
usage_alert_s:
	dc.b	'[1]['
	dc.b	'F_BOOT usage:|'
	dc.b	'Use a code before each font, |'
	dc.b	'to decide its future use:    |'
	dc.b	'0:Default font   1:Small font|'
	dc.b	'2:Medium font    3:Large font]'
	dc.b	'[ Exit ]',NUL
	even
;
error_alert_s:
	dc.b	'[1]['
	dc.b	'F_BOOT error:|'
	dc.b	'  Something has gone wrong ! ]'
	dc.b	'[ Exit ]',NUL
	even
;
default_arg_t:
	dc.b	'F_BOOT.PRG',NUL
	dc.b	'1',NUL
	dc.b	'FBOO_??1.FNT',NUL
	dc.b	'2',NUL
	dc.b	'FBOO_??2.FNT',NUL
	dc.b	'3',NUL
	dc.b	'FBOO_??3.FNT',NUL
	dc.b	NUL
	even
;
;----------------------------------------------------------------------------
	SECTION	bss
;----------------------------------------------------------------------------
;
		ds.l	$1000
mystack:	ds.l	4
;
current_code:	ds.w	1
;
font_lasc:	ds.w	1
font_hasc:	ds.w	1
font_flag:	ds.w	1
font_hor_tp:	ds.l	1
font_chr_tp:	ds.l	1
font_fbase:	ds.l	1
;
font_size:	ds.w	1
;
fontpath_s:	ds.b	140
;
intin:		ds.w	30
intout:		ds.w	45
ptsin:		ds.w	30
ptsout:		ds.w	12
message:	ds.b	16
;
;----------------------------------------------------------------------------
	End
;----------------------------------------------------------------------------
;End of file:	F_OLD.S
;----------------------------------------------------------------------------
