*************************************************************************
*			STEAL font program for PE menu.			*
*			-------------------------------			*
*									*
* Run this program to remove the font from 2 pi1's for PE menu		*
*									*
*************************************************************************

	jmp	skip
filename	dc.b	"new_font.FNT",0	;destination name
	even
pic1	incbin	"newfont1.pi1"	;source picture
pic2	incbin	"newfont2.pi1"	;source picture


skip	bsr	set_super
	dc.w	$a00a
	bsr	get_screen_base
	bsr	get_old_palette
	bsr	set_new_palette
	bsr	get_original_rez
	bsr	set_low_rez

	move.l	screen_base,a1
	lea	pic1+34,a0
	move.w	#32000/4-1,d0
loop:	move.l	(a0)+,(a1)+
	dbf	d0,loop
	
	move.l	screen_base,a0

DEPTH	equ	32
	move.l	a0,a6
	lea	buffer,a1
	moveq	#6-1,d2			;characters lines down screen
.repeat	move.l	a6,a0
	move.w	#(5*8)-1,d1		;8 wide, 5 across
.across	move.w	#DEPTH-1,d0
.shift	move.b	(a0),d7
	move.b	d7,(a1)+
	not.b	(a0)
	not.b	2(a0)
	not.b	4(a0)
	not.b	6(a0)
	add.w	#160,a0
	bsr	pause
	dbf	d0,.shift
	sub.w	#(160*DEPTH)-1,a0
	move.w	a0,d0
	btst.l	#0,d0
	bne.s	.ok
	addq.w	#6,a0
.ok	dbf	d1,.across
	add.w	#DEPTH*160,a6
	dbf	d2,.repeat



take2	lea	pic2+34,a2
	move.l	screen_base,a0
	move.w	#32000/4-1,d0
.sh	move.l	(a2)+,(a0)+
	dbf	d0,.sh

	move.l	screen_base,a0
	move.l	a0,a6
	moveq	#3-1,d2			;characters lines down screen
.repeat	move.l	a6,a0
	move.w	#(5*8)-1,d1		;8 wide, 5 across
.across	move.w	#DEPTH-1,d0
.shift	move.b	(a0),d7
	move.b	d7,(a1)+
	not.b	(a0)
	not.b	2(a0)
	not.b	4(a0)
	not.b	6(a0)
	add.w	#160,a0
	bsr	pause
	dbf	d0,.shift
	sub.w	#(160*DEPTH)-1,a0
	move.w	a0,d0
	btst.l	#0,d0
	bne.s	.ok
	addq.w	#6,a0
.ok	dbf	d1,.across
	add.w	#DEPTH*160,a6
	dbf	d2,.repeat

	move.l	a1,a5	
;now save
	bsr	f_create
	move.l	a5,a1
	bsr	f_write
	bsr	f_close

	bsr	set_old_palette
	bsr	set_med_rez
	dc.w	$a009
	bsr	set_user

	MOVE.W	#$0,-(SP)	; RETURN TO GEM DESKTOP.
	TRAP	#1


***********************
* SUBROUTINES SECTION *
***********************

f_create:
	move.w	#0,-(sp)
	pea	filename
	move.w	#$3c,-(sp)
	trap	#1
	add.l	#8,sp
	move.w	d0,handle
	rts

f_write:
	lea	buffer,a0
	sub.l	a0,a1
	move.l	#buffer,-(sp)
	move.l	a1,-(sp)
	move.w	handle,-(sp)
	move.w	#$40,-(sp)
	trap	#1
	add.l	#12,sp
	rts

f_close:
	move.w	handle,-(sp)
	move.w	#$3e,-(sp)
	trap	#1
	addq.l	#4,sp
	rts

pause:	move.w	d0,-(sp)
	move.w	#100,d0
pau:	nop
	dbf	d0,pau
	move.w	(sp)+,d0
	rts

get_key:
	move.w	#7,-(sp)
	trap	#1
	addq.l	#2,sp
	rts

set_super:
	clr.l	-(sp)		;Set super stack equal
	move.w	#$20,-(sp)	; to user stack before call
	trap	#1
	addq.l	#6,sp		;correct stack
	move.l	d0,stack_save	;save old supervisor stack value
	rts
set_user:
	move.l	stack_save,-(sp)
	move.w	#$20,-(sp)
	trap	#1		;back to user
	addq.l	#6,sp		;correct stack
	rts

get_old_palette:
	move.w	#8-1,d0
	lea	$ff8240,a0
	lea	old_palette,a1
get_old:
	move.l	(a0)+,(a1)+
	dbf	D0,get_old
	rts

set_new_palette:
	lea	pic1+2,a0
	bra	set_pal
set_old_palette:
	lea	old_palette,a0
set_pal:
	lea	$ff8240,a1
	move.w	#8-1,d0
set_p:	move.l	(a0)+,(a1)+
	dbf	d0,set_p
	rts

get_screen_base:
	move.w	#3,-(sp)
	trap	#14
	addq.l	#2,sp
	move.l	d0,screen_base
	rts

get_original_rez:
	move.w	#4,-(sp)
	trap	#14
	addq.l	#2,sp
	move.w	d0,original_rez
	rts

set_low_rez:
	clr.w	-(sp)
	bra	set_rez
set_med_rez:
	move.w	#1,-(sp)
set_rez:
	move.l	#-1,-(sp)
	move.l	#-1,-(sp)
	move.w	#5,-(sp)
	trap	#14
	add.l	#12,sp
	rts

****************
* DATA SECTION *
****************
stack_save:	dc.l	0
screen_base	dc.l	0
original_rez:	dc.w	0
handle:		dc.w	0
old_palette:	ds.w	16
	even
buffer	ds.l	1