opt c-
	section blitter,code_c			Chip Ram please !!
	include	df1:definitions			Give me some hardware reggies
	include	df1:macros				Give me some macros
	
		
;LOCAL CONSTANTS

icra		equ $bfed01				
allocmem 	=-30-168				
freemem 	=-30-180				
fontmemory	=4000

		

TAKEOVER:
		
	LEA custom,a5		
	LEA GFXLIB(PC),a1			 Point to 'graphics.library'
	MOVEQ #0,D0					 Doesn't matter which version
 	MOVE.L 4.w,a6				 EXECBASE
	jsr	-132(a6)				 task switching off (forbid)
 	JSR -$228(a6) 				 Openlibrary
 	MOVE.L D0,GFXBASE			 Store library address

		
;Now put the graphic addresses in the CopperList 		

 	move.l	#sin_screen,d1		Bitplane memory address
 	move.w	d1,bp1lo+2
 	swap	d1
 	move.w	d1,bp1hi+2

	
 	move.l GFXBASE,d0			Move gfxbase offset to d0
 	MOVE.L D0,A6				
 	MOVE.W #$80,dmacon(a5)		Turn off copper whilst changing it
 	MOVE.L $32(A6),WBCOPPER	 	Store old (WBench) copper address
 	MOVE.L #OURCOPPER,$32(A6)	Point to new copper list (our own)
 	MOVE.W #$8080,dmacon(a5)    re-enable copper

 	MOVE.W #$8010,intena(a5)		
 	MOVE.L $6c,old				Save work bench interrupt
 	MOVE.L #LEV3,$6c			This sets up a level 3 interrupt
	move.w	intenar(a5),systemints
	move.b	#%01111111,icra		Kill keyboard
		
WAIT: 	
	BTST #6,$BFE001				This waits for the left
 	BNE.S	WAIT				mouse button to be pressed
	move.l	4.w,a6				EXECBASE
 	MOVE.L old,$6c				Restore system interrupts
	MOVE.L GFXBASE,A6
 	MOVE.W #$80,dmacon(a5)		Disable DMA
 	MOVE.L WBCOPPER,$32(A6)		Restore old copperlist
 	MOVE.W #$8080,dmacon(a5)	Enable DMA
 	move.w	systemints,d0		Systems interrupt
 	or.w	#$c000,d0
 	move.w	d0,intena(a5)		Enable OS interrupts
 	move.b	#%10011011,icra		Enable keyboard
	clr.w	$dff0a8				Clear music
	clr.w	$dff0b8
	clr.w	$dff0c8
	clr.w	$dff0d8
	move.w	#$f,$dff096
	rts


ERROR:	
	move.l 4.w,a6				Get EXECBASE
	jsr	-138(a6)				Permit ( multi-tasking on )
	moveq	#0,d0				Clear d0
 	RTS							Return to AmigaDOS


;This is the NEW level 3 interrupt

LEV3:
 	MOVEM.L d0-d7/a0-a6,-(sp)	Save all registers to the stack
	lea	custom,a5
	AND #$10,intreqr(a5)       	Check if interrupt is from Copper 
	BNE out
	move.w	#$8010,$9c								

	bsr	try_sin
	bsr	scroll
	

out: 	
	MOVEM.L (sp)+,d0-d7/a0-a6	Restore the registers
	DC.W $4ef9					hex value for  JMP instruction
old: 	
	DC.L 0						will jump to normal interrupt

												
; ** THE SCROLL ROUTINE **

scroll
	cmp.l	#15,val					Blitshifted all <<<
	blo.s	coarse_scroll_it		No then get doing it !!
	bsr		blit_char				Blit letter to screen
	clr.l	val						Reset index
coarse_scroll_it:
	bsr		coarse					Scroll all line
	rts							
	
	
; ** BLIT LETTER ON THE SCREEN **

blit_char
	jsr		text
	lea		custom,a5				Get custom chip address
	move.l	screenx,a0			 	Can~t see this picture !!
	move.l	#font,a1			 	Put font in blitter source
	add.l	d1,a1
blit_test:
	btst	#14,$dff002			 	Blitter busy !!!
	bne	blit_test				 	Lets wait till she finishes !
	move.w	#$ffff,bltafwm(a5)		Mask (DON'T NEED ONE)
	move.w	#$ffff,bltalwm(a5)		Mask (DON'T NEED ONE)
	move.l	a0,bltdpth(a5)		 	Blitter dest D (BOTTOM OF SCREEN)
	move.l	a1,bltapth(a5)		 	Blitter source A (SCROLLING FONT)
	move.w	#38,bltamod(a5)		 	Modulo (20-1)*2
	move.w	#38,bltdmod(a5)		 	Modulo (20-1)*2
	move.w	#$9f0,bltcon0(a5)	 	Minterms D=A
	clr.w	bltcon1(a5)			 	Set Ascending mode
 	move.w	#16*64+1,bltsize(a5) 	Blit size (SIZE OF FONT)
	rts							  	Return


; ** BLITSHIFT THE ENTIRE SCROLL LINE (BETTER THAN USING THE HARDWARE).

coarse:
	lea		custom,a5			 	
	move.l	screenx,a0				; Can~t see this picture !!
	move.l	a0,a1
	add.l	#2,a1
blit_wait:
	btst	#14,$dff002			
	bne		blit_wait
	incl	#4,val					; (1 for slower)
	move	#12,d7					; Amount of pixels to shift(15 for slow)
	ror		#4,d7					; Set to correct bits (12-15)
	or		#%100111110000,d7		
	move.l	#-1,bltafwm(a5)
	move.l	a1,bltapth(a5)
	move.l	a0,bltdpth(a5)
	move.w	#0,bltamod(a5)
	move.w	#0,bltdmod(a5)
	move.w	d7,bltcon0(a5)	
	move.w	#80*64+20,bltsize(a5)
	rts	


; ** BLITTER CLEAR WHERE THE SINE SCROLL HAS JUST BEEN **

CLEAR:
	Move.l	#sin_screen,a0
wate
	btst	#14,$dff002
	bne.s	wate
	Move.l	a0,Bltdpth(a5)
	Move	#0,Bltdmod(a5)
	Move.l	#$1f00000,Bltcon0(a5)
	Move	#80*64+20,Bltsize(a5)
	Rts



try_sin:
	bsr		clear
	Move.l		Table1,A3
	Move.b		(A3),d1
	Cmp.b		#$ff,d1
	Bne			ItsOkYa
	Move.l		#SinTab,A3
ItsOkYa
	Add.l		#$1,A3
	Move.l		a3,Table1
	Move.l		A3,Table
	lea		custom,a5			 	
	move.l	screenx,a0			 	; Source A
	move.l	#20,d4					; Number of chars along screen
	clr.l	d5
	clr.l	d6
blit_test0:
	btst	#14,$dff002			 	
	bne	blit_test0				 	
	move.l	#sin_screen,a1
	bsr		get_sinvalue
	move.w	#$ffff,bltafwm(a5)		
	move.w	#$ffff,bltalwm(a5)		
	move.l	a1,bltdpth(a5)		 	
	move.l	a0,bltapth(a5)		 	
	move.w	#38,bltamod(a5)		 	
	move.w	#38,bltdmod(a5)		 	
	move.w	#$9f0,bltcon0(a5)	 	
	clr.w	bltcon1(a5)			 	
 	move.w	#16*64+1,bltsize(a5) 	
	add.l	#2,a0					; Get next letter along
	add.l	#2,d6
	dbf		d4,blit_test0
	rts							  	

get_sinvalue:
	Clr.l	D5
	Move.l	Table,A3
	Move.b	(A3),d5
	cmp.b	#$ff,d5
	bne		aslam
	Move.l	#SinTab,A3
	Move.b	(a3),d5
Aslam
	Add.l	#$1,A3
	Move.l	A3,Table
	mulu	#40,d5
	add.l	d5,a1
	Add.l	D6,A1
	rts
Table1:	Dc.l	SinTab	
table:	dc.l	sintab
sintab:
	dc.b $3C,$3F,$42,$46,$49,$4C,$50,$53,$56,$59
	dc.b $5C,$5F,$61,$64,$67,$69,$6B,$6D,$6F,$71
	dc.b $72,$73,$75,$76,$76,$77,$77,$77,$77,$77
	dc.b $77,$76,$76,$75,$73,$72,$71,$6F,$6D,$6B
	dc.b $69,$67,$64,$61,$5F,$5C,$59,$56,$53,$50
	dc.b $4C,$49,$46,$42,$3F,$3C,$38,$35,$31,$2E
	dc.b $2B,$27,$24,$21,$1E,$1B,$18,$16,$13,$10
	dc.b $E,$C,$A,$8,$6,$5,$4,$2,$1,$1
	dc.b $0,$0,$0,$0,$0,$0,$1,$1,$2,$4
	dc.b $5,$6,$8,$A,$C,$E,$10,$13,$16,$18
	dc.b $1B,$1E,$21,$24,$27,$2B,$2E,$31,$35
	dc.b $38,255
 Even

; ** CHARACTER DECODER ROUTINE **

text:
	move.l	acurent,a2				Get message
	clr.l	d1						
	move.b	(a2)+,d1				Update it
	move.b	d1,letter				Store in offset
	cmp.b	#255,d1					Check for end of message
	beq.w	rst_text				If equal, then reset
	sub.l	#32,d1					Subract 32 (ie space)
	asl		d1						Times by 2 
	move.l	a2,acurent				Update acurent
	CMP.B	#"4",letter				Is letter "K" or larger
	BPL.s	add_more				If larger then add on
	rts								Return
add_more:
	CMP.B	#"H",letter				Is letter "U" or larger
	BPL.S	add_more2				If larger then add on
	add.l	#40*15,d1				Get next line down (KLMNOPQRST)
	rts
add_more2:					
	add.l	#40*30,d1				Get next line down (UVWXYZ0123)
	rts
rst_text:
	move.l	#0,d1
	move.l	#message,d2				Get begining of text
	move.l	d2,acurent				Reset to begining
	rts								Return


message:

; *=FACE	

	DC.B	"TANGO OF CRYPTIC UK PRESENTS A SMALL INTRO NO WAY NEAR"
	DC.B	" FINISHED.    "
	DC.B	255
	EVEN
			

; ** THE COPPERLIST **

OURCOPPER:
		dc.w	$120,0
		dc.w	$122,0
		dc.w	bpl1mod,0,bpl2mod,0
		dc.w	diwstrt,$2c81+32,diwstop,$2cc1-32
		dc.w	bplcon0,$1200,bplcon1,$0000
		dc.w	ddfstrt,$38,ddfstop,$d0
		dc.w	color00,$000,color01,$094
bp1lo:	dc.w	bpl1ptl,$0000
bp1hi:	dc.w	bpl1pth,$0000
		end_copper
		

;LOCAL CONSTANTS

WBCOPPER:		DC.L	0
GFXLIB:			DC.B 	"graphics.library",0
GFXBASE:		DC.L	0
systemints:		dc.l	0
scroll_offset:	dc.l	0
screenx:		dc.l	picture
letter:			dc.b	0
acurent:		dc.l	message
val:			dc.l	0


;BINARY FILES TO BE INCLUDED
	EVEN
picture	
	dcb.b	10240,0
sin_screen:
	dcb.b	10240,0
font
	incbin	df1:neatfont.bin