;--------------------------------------------------
;---	     S.M.F BootBlock-Intro!!		---
;---		written in 1988			---
;---	by Black Hammer of the great SMF	---
;---	write to : Secret (Magic) Forces	---
;---	PLK 028714 B, 4000 Duesseldorf 30	---
;---	West Germany				---
;--------------------------------------------------
;**************************************************
;		   Achtung !!!
;***** Dieses Programm schreibt den BootBlock *****
;***** auf die einliegende Diskette  !!!!!!!! *****
;		   Achtung !!!
;**************************************************
execbase = 4
findtask = -294
addport  = -354
remport  = -360
openlib  = -408
closelib = -414
opendev  = -444
closedev = -450
doio     = -456

start:
	move.l	execbase.w,a6		;install trackdisk.device
	sub.l	a1,a1
	jsr	findtask(a6)		;find own task
	lea	readreply(pc),a0
	move.l	d0,$10(a0)		;and write to IO_ReadReply

	lea	readreply(pc),a1	;Get Port
	jsr	addport(a6)

	lea	diskio(pc),a1		;IO_structure in a1
	move.l	#0,d0
	clr.l	d1
	lea	trddevice(pc),a0	;open Trackdisk.device
	jsr	opendev(a6)
	tst.l	d0
	bne	error

	lea	diskio(pc),a1
	lea	readreply(pc),a0
	move.l	a0,14(a1)
	move.w	#2,28(a1)		;read original boottrack
	move.l	#$40000,40(a1)
	move.l	#22*512,36(a1)
	move.l	#0*512,44(a1)
	move.l	execbase.w,a6
	jsr	doio(a6)

	bsr	checksum		;new checksum
	bsr	copy			;copy own routine

	lea	diskio,a1		;and write new boottrack
	move.w	#3,28(a1)
	move.l	#$40000,40(a1)
	move.l	#22*512,36(a1)
	move.l	#0*512,44(a1)
	move.l	execbase.w,a6
	jsr	doio(a6)

	lea	diskio,a1
	move.w	#9,28(a1)		;stop drive
	move.l	#0,36(a1)
	jsr	doio(a6)

	lea	readreply(pc),a1	;clear Port
	jsr	remport(a6)

	lea	diskio(pc),a1
	jsr	closedev(a6)		;close trackdisk.device
error:
	rts				;end

trddevice:  dc.b 'trackdisk.device',0
even
diskio:     blk.l 20,0
readreply:  blk.l  8,0

checksum:
	lea	BootBlockIntro+8(pc),a0	;start for new checksum
	lea	$3f8(a0),a1		;end of bootblock
	clr.l	d0
	clr.l	d1
	move.w	#$444f,d0		;'DO' in d0
	move.w	#$5300,d1		;'S ' in d1
l1:	add.w	(a0)+,d0		;add 1 word to d0
	bcs	m1			;overflow ?
w1:	add.w	(a0)+,d1		;add 1 word to d1
	bcs	m2			;overflow ?
w2:	cmp.l	a0,a1			;end reached ?
	bne	l1			;if not : continue
	not.w	d0			;invert d0
	not.w	d1			;invert d1
	swap	d0			;LO-word to HI-word
	move.w	d1,d0			;d1 new Lo-word of d0
	move.l	d0,BootBlockIntro+4	;write checksum
	rts				;end
m1:	add.w	#1,d1			;overflow in d0: increment d1
	bra	w1
m2:	add.w	#1,d0			;overflow in d1: increment d0
	bra	w2

copy:	lea	BootBlockIntro(pc),a0	;startadress of copy
	lea	$40000,a1		;destinationadress of copy
	move.w	#$3ff,d0		;length: 1024 byte
loopy:	move.b	(a0)+,(a1)+		;copyloop
	dbf	d0,loopy
	rts				;End

BootBlockIntro:
	dc.l $444f5300,0,$370		;'DOS',checksum,Rootblock
allocmem = -198				;Exec-Routinen
freemem  = -210

	movem.l	d0-d7/a0-a6,-(a7)	;save registers
	move.l	#$10000,d0
	move.l	#$30003,d1
	move.l	execbase.w,a6
	jsr	allocmem(a6)		;Allocate 65536 Byte
	move.l	d0,a0			;save adresses
	lea	Bpl1(pc),a1
	moveq	#3,d0
loop40:	move.l	a0,(a1)+		;Bitplane start (1-4)
	lea	$4000(a0),a0
	dbf	d0,loop40
	move.l	Bpl1(pc),a0		;Bitplane 1 in a0
	move.l	Bpl2(pc),a1		;Bitplane 2 in a1
	lea	tab(pc),a2		;tab of grid
	clr.l	d0
	clr.l	d1
	clr.l	d2
	move.w	#$0130,d3		;how many lines ?
ef4:	move.b	$00(a2,d2),d1		;build grid
	move.b	$08(a2,d2),d4
	move.b	#$2d,d0
memo:	move.b	d1,(a0)+
	move.b	d4,(a1)+
	dbf	d0,memo
	add.w	#1,d2
	and.w	#$07,d2
g4:	clr.l	d0
	dbf	d3,ef4
	moveq	#1,d3
	move.l	Bpl4(pc),a0		;set holes (in Bpl4)
	lea	$2ac4(a0),a0
	move.w	#20,d0			;scrollhole - hight
loop13:	move.w	#$2d,d1			;scrollhole - width
loop14:	move.b	#$ff,(a0)+		;its not a real hole
	dbf	d1,loop14
	dbf	d0,loop13
	move.l	Bpl4(pc),a0		;adress of greetings
	lea	$19e0(a0),a0
	move.w	#8,d0			;Hight of hole - 8 lines
	dbf	d3,loop13
	lea	greets(pc),a0		;textadress in a0
	move.l	Bpl3(pc),a3		;startadress of text in Bpl
	lea	$1a0e(a3),a3
	move.w	#40,d0			;how many letters ?
	bsr	greetings
	move.l	Bpl4(pc),a0		;adress of hole for name
	lea	$5cb(a0),a0
	move.w	#20,d0			;hight : 20 lines
loop30:	move.w	#20,d1			;width : 20 Byte
loop31:	move.b	#$ff,(a0)+
	dbf	d1,loop31
	lea	$19(a0),a0		;next line
	dbf	d0,loop30
	lea	name(pc),a0		;Textadress in a0
	move.l	Bpl3(pc),a3		;Textadress in Bpl
	lea	$70d(a3),a3
	move.w	#20,d0			;Length : 20 letters
	bsr	greetings
	lea	no1(pc),a0		;change trapvectors 
	lea	$0080.w,a1		;to own routinens 
	moveq	#7,d0			;(Backgroundscroll)
loop3:	move.l	a0,(a1)+
	lea	$6(a0),a0
	dbf	d0,loop3
	lea	text(pc),a0		;Trapvector for scrolltext
	move.l	a0,$00bc.w
	lea	$dff000,a6		;Basicadress Copper
	move.w	#$00a0,$96(a6)		;disable Copper+Sprite DMA
	move.w	#$4600,$100(a6)		;4 Bpl/Dual playfield mode
	move.l	#$002800d8,$92(a6)	;DDFstart-stop (48 Byte/line)
	move.l	#$1c6135d1,$8e(a6)	;Displaywindow
	clr.l	$0108(a6)		;no Bplmodulo
	move.w	#$0040,$104(a6)		;Plf 2 priority
	move.l	#$00000007,$0180(a6)	;Color of grid
	move.l	#$0000000d,$0184(a6)
	move.l	#$00000000,$0192(a6)	;Color of text
	move.l	#$00f00000,$0196(a6)
	move.w	#$0020,$9a(a6)		;disable vert. blanc IRQ
	move.w	#$8350,$96(a6)		;enablen DMA
	lea	trp+1(pc),a0		;trapadress in a0
bb:	move.w	$6(a6),d7		;Beam position in d7
	sub.w	#$0020,d7
	and.w	#$3f,d7			;d7 = length of a scroll
	move.w	d7,d6
	eor.w	#$07,d7
	and.w	#7,d6			;d6 = scrolldirection
	add.w	#$0040,d6		;direction + 64 (for Trap)
	move.b	d6,(a0)			;write d6
wait:	move.w	$1e(a6),d4		;wait for vert. blanc
	btst	#5,d4
	beq	wait
	move.w	#$0020,$9c(a6)		;clear vert. blanc
trp:	trap	#$0			;jmp to backgroundscroll
	bsr	BplSet			;set Bplstart
	trap	#$f			;Scrolltext
	trap	#$f
	btst	#6,$bfe001		;Mousebutton pressed??
	beq	end			;yes : end
	dbf	d7,wait			;else same direction again
	bra	bb			;or new direction

end:	move.w	#$81f0,$96(a6)		;enable DMA
	move.w	#$8020,$9a(a6)		;permit vert. blanc
	move.l	execbase.w,a6
	move.l	Bpl1(pc),a1
	move.l	#$10000,d0
	jsr	freemem(a6)		;FreeMemory
	movem.l (a7)+,d0-d7/a0-a6	;get registers
	lea	dosname(pc),a1		;normal bootblock routine
	jsr	-$60(a6)
	move.l	d0,a0
	move.l	$16(a0),a0
	moveq	#00,d0
	rts				;End of Intros

BplSet:	movem.l	d0-d7/a0-a6,-(a7)	;save registers
	move.l	Bpl1(pc),a2		;Bpl1 adress in a2
	and.w	#$07,d0			;look at Bit 0-3
	mulu	#$2e,d0			;Scroll in Y-direction
	add.l	d0,a2
	move.l	a2,$00e0(a6)		;set Bpl1 start
	add.l	#$4000,a2
	move.l	a2,$00e8(a6)		;set Bpl3 start
	and.w	#$07,d1			;look at Bit 0-3
	or.w	#$f0,d1			;Scrollvalue EvenPlanes = 15
	move.w	d1,$0102(a6)		;set scrolllevel
	move.l	Bpl3(pc),$00e4(a6)	;set playfield 2
	move.l	Bpl4(pc),$00ec(a6)
	movem.l	(a7)+,d0-d7/a0-a6	;get register
	rts				;End

no1:	trap	#$4			;scroll grid
	bra	rec			;no1-no4 -> diagonal
no2:	trap	#$5
	bra	rec
no3:	trap	#$4
     	bra	left
no4:	trap	#$5
     	bra	left

auf:	sub.b	#1,d0			;decrement counter
	rte				;End
ab:	add.b	#1,d0			;increment counter
	rte				;End
rec:	sub.w	#1,d1			; usw.
	rte
left:	add.w	#1,d1
	rte

text:
	movem.l	d0-d7/a0-a6,-(a7)	;save register
	clr.l	d0
	clr.l	d1
	move.l	Bpl3(pc),a0		;scrollstart in a0
	lea	$2b4e(a0),a0
	move.w	#$10,d0			;scroll 17 lines
loop1:	move.w	#$0000,CCR
	bsr	scroll
	lea	$5c(a0),a0		;a0 to end of next line
	dbf	d0,loop1		;go on scrolling
	clr.l	d0
	clr.l	d1
	clr.l	d2
	move.l	actual_letter(pc),a0	;adress of letter in a0
	move.l	Bpl3(pc),a1		;right scrollborder line 1
	lea	$2b4d(a1),a1
	lea	$2e0(a1),a2		;right scrollborder line 17
	moveq	#7,d2			;do next steps 8 times
	move.b	pixel_counter(pc),d0	;how many pixel are scrolled?
	move.b	#1,d3			;prepare d3
loop2:	move.b	(a0),d1			;read 1 character-byte
	lea	$c0(a0),a0		;and point to next byte
	lsl.b	d0,d1			;test 1 bit
	bcc	loop5			
	or.b	#$80,(a1)		;set: 1 Bit in line 1
	or.b	d3,(a2)			;and on a diagonal line in 17
loop5:	lsl.b	#1,d3			;d3 is that diagonal line
	lea	$2e(a1),a1		;a1 to next line
	lea	-$2e(a2),a2		;a2 to previous line (mirror)
	dbf	d2,loop2
	lea	pixel_counter(pc),a0
	add.b	#1,(a0)			;1 pixel more scrolled
	cmp.b	#9,(a0)			;allready 8 pixels ?
	bne	loop63
	move.l	scroll_counter(pc),a0	;a0 = actual letter
	clr.l	d0
	cmp.b	#$00,(a0)		;last letter ?
	bne	weiter
	lea	scrolltext(pc),a0	;start again
weiter:	move.b	(a0)+,d0		;read new letter
	lea	scroll_counter(pc),a1	;increment counter
	move.l	a0,(a1)
	sub.b	#$20,d0
	lea	$fc90f4,a0		;adresse in Topaz.font
	add.l	d0,a0			;
	lea	actual_letter(pc),a1	;save adress
	move.l	a0,(a1)
	lea	pixel_counter(pc),a0	;clear pixel Counter
	clr.b	(a0)
loop63:	movem.l	(a7)+,d0-d7/a0-a6	;get register
	rte				;End

scroll:
	move.w	#$16,d1			;ROL the bits through the
loop64:	roxl.b	#1,-(a0)		;bitplane (scrolling)
	dbf	d1,loop64
	clr.l	d1
	rts

greetings:
loop20:	clr.l	d2			;build up the screen
	move.l	a3,a1
	moveq	#7,d1
	move.l	actual_letter(pc),a2	;startadress Topaz.font
	move.b	(a0)+,d2
	sub.b	#$20,d2
	add.l	d2,a2
loop21:	move.b	(a2),(a1)		;get character code
	lea	$c0(a2),a2		;and write to bitplane
	lea	$2e(a1),a1
	dbf	d1,loop21
	lea	1(a3),a3
	dbf	d0,loop20		;as long as there are letters
	rts


actual_letter:	dc.l $fc90f4		;the rest are datas
scroll_counter:	dc.l 0			;(texts may be changed)

Bpl1:	dc.l 0
Bpl2:	dc.l 0
Bpl3:	dc.l 0
Bpl4:	dc.l 0

tab:	dc.b $ff,$ff,$ff,$ff,$c3,$c3,$c3,$c3
	dc.b $ff,$ff,$03,$03,$3f,$3f,$3f,$3f

dosname:dc.b "dos.library",0

; Never make the texts longer than the demo-texts !!!!!!!!
 
greets:	dc.b "  brought to you by REDSECTOR & SINNERS  "
name:	dc.b "  COMPACTINGS # 21    "

pixel_counter:	dc.b 0

scrolltext:	;Not longer than this demotext !!!  V
dc.b "REDSECTOR R now: MZP - IRATA - DR. CHIP - PBA "
dc.b "- DAG - KANGOLKID - BILL - GREG - MERLIN      "
dc.b 0