bra	skip
filename	dc.b	"compfont.dat",0	;destination name
	even
pic	incbin	"compfont.pi1"	;source picture
	even

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	pic+34,a0
		move.w	#32000/4-1,d0
loop		move.l	(a0)+,(a1)+
		dbf	d0,loop
	
		move.l	screen_base,a0

DEPTH=16
		lea	buffer,a1
		move.l	a0,a6
		move.w	#5-1,d0
down		move.w	#20-1,d1
across
offset	set	0
		REPT	DEPTH
		move.b	offset(a0),(a1)+
		move.b	#-1,offset(a0)
offset		set	offset+160
		bsr	pause
		endr
		add.w	#8,a0
		dbf	d1,across

		lea	160*18(a6),a6
		move.l	a6,a0
		dbf	d0,down

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

		bsr	set_old_palette
		bsr	set_med_rez
		dc.w	$a009
		bsr	set_user

		clr.w	-(sp)
		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
		move.l	a0,-(sp)
		sub.l	a0,a6
		move.l	a6,-(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	#3000,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	movem.l	$ffff8240.w,d0-d7
		movem.l	d0-d7,old_palette
		rts

set_new_palette	lea	pic+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.b	2