***********************************************************
*    System `Fade-Text` Routine   (Devpac 2 Source)       *
* 							  *
*       By Maurice `Digital Dictator` Wielink 		  *
* Hondemanstraat 51, 1508 GA, Zaandam, The Netherlands    *
*							  *
* Coded For the Programming Section on NEWSFLASH Magazine *
***********************************************************

NrLines		equ	7			;Nr of Lines in Text

		movem.l	d0-d7/a0-a6,-(a7)	;Save Registers on Stack
		bra	BOOST
*-----------------------------------------------*
*--------------	A6 = GfxBase
*--------------	A5 = WD_RastPort
*--------------	A4 = Address of TEXT
*--------------	A3 = Scr_ViewPort
*-----------------------------------------------*
DoText		move.l	#NrLines-1,D6		;Nr of Lines -1
		lea	Text(pc),A4		;Address of Text Data at a4

NextTxt 	moveq	#10,D0			;X Coordinate of Text
		moveq	#100,D1			;Y Coordinate of Text	
		movea.l	A5,A1			;Windows RastPort (a5) at a1			
		JSR	-$F0(A6)		;_LVOMove
		movea.l	A4,A0			;Get Text Data
		moveq	#38,D0			;Nr of Chars in Line
		lea	(a4,d0),a4		;Next Line in text (a4 + 38)
		JSR	-$3C(A6)		;Print our TEXT 

        	jsr	FadeIn(pc)		;Color Fade-In (Display Text)
		jsr	FadeOut(pc)		;Color Fade-Out		

		btst	#6,$BFE001		;Check Left Mouse Button !
		beq	Quit	 		;Quit if Button was Down.
						;If not.....
		dbf	D6,NextTxt		;......Do next Line of Text
						;Until all lines are done....
		bra.s	DoText			;....Reset and Loop Again !

*-----------------------------------------------*
*-------------- Color Fade Routines

FadeOut		moveq	#14,D7			;15 Values per Color
_FOLoop		lea	CMap(pc),A1		;Get CMap
		subi.w	#$111,2(A1)		;Chance Color02 
		JSR	_RGB(pc)		;Use Subroutine
		dbf	d7,_FOLoop
		rts

FadeIn		moveq	#14,D7			;15 Values per Color
_FILoop		lea	CMap(pc),A1		;Get CMap
		addi.w	#$111,2(A1)		;Chance Color02 
		JSR	_RGB(pc)		;Use Subroutine
		dbf	d7,_FILoop
		rts

_RGB:		MOVEA.L	A3,A0			;Screens ViewPort at a0
		MOVEQ	#2,D0			;Nr of Colors
		JSR	-$C0(A6)		;LoadRGB4
		moveq	#50,d5			;Delay Value in d5
		jsr	Delay(pc)		;...use Delay Routine
		rts

*-----------------------------------------------*
*-------------- Delay Routine

Delay 		btst	#6,$BFE001		;Check for Abort
		beq.s	_Delex
		cmpi.b	#200,$DFF006		;Check Vertical Beam Position
		bne.s	Delay			;If not 200, Loop
		dbf	d5,Delay			
_Delex		rts
*-----------------------------------------------*

*****************************************************************************
*-------------- Open Libraries, Screen, Window, Set colors

BOOST		MOVEA.L	4.W,A6			;ExecBase at A6
		lea	IntName(pc),A1		;Intuition.lib Name
		MOVEQ	#0,D0
		JSR	-$228(A6)		;Open IntLib
		MOVE.L	D0,IntBase		;Save Address
		BEQ	_Error			;Branch incase of Error

		lea	GfxName(pc),A1
		MOVEQ	#0,D0
		JSR	-$228(A6)		;Open GfxLib (ExecBase at A6)
		MOVE.L	D0,GfxBase		;Save Address
		BEQ	_CloseInt

		lea	NewScreen(pc),A0	;Screen Structure
		MOVEA.L	IntBase,A6		;IntBase
		JSR	-$C6(A6)		;OpenScreen
		MOVE.L	D0,ScreenBase		;Save ScreenBase
		BEQ	_CloseGfx		;branch incase of Error

		MOVEA.L	d0,A0			;ScreenBase at a0
		lea	$2C(a0),a3	*------> A3 = Scr_ViewPort

		lea	CMap(pc),a1		;CMap
		MOVEQ	#2,D0			;Nr of Colors
		MOVEA.L	GfxBase,A6		;GfxBase
		JSR	-$C0(A6)		;Load RGB4 (a0 = Viewport)

		lea	NewWindow(pc),a0	;Window Structure
		MOVE.L	ScreenBase,D0		;ScreenBase
		MOVE.L	D0,$1E(A0)		;Store ScrPTR in Window		
		MOVEA.L	IntBase,A6		;IntBase
		JSR	-$CC(A6)		;OpenWindow
		MOVE.L	D0,WindowBase		;Save  Window Base
		BEQ	_CloseScreen		;branch incase of Error

		MOVEA.L	d0,A0			;WindowBase at a0
		movea.l	$32(a0),a5	*------> A5 is at WD_RastPort now

		MOVEA.L	GfxBase,A6		;GfxBase
		movea.l	a5,a1			;WD_RastPort at a1
		MOVEQ.L	#1,D0			;Color in CMap
		JSR	-$156(A6)		;SetAPen

		move.w	#$3A,$DFF096		;Remove Mouse Pointer

		MOVEA.L	4,A6			;ExecBase
		JSR	-$84(A6)		;Forbid
		*-------------------*
		MOVEA.L	GfxBase,A6	*------> GfxBase at a6
		BRA	DoText			;START !!!
*-----------------------------------------------*
*-------------- Clean Up

Quit		move.w	#$803A,$DFF096			;Mouse Pointer Back
		MOVEA.L	4,A6				;ExecBase				
		JSR	-$8A(A6)			;Permit
_CloseWindow	MOVEA.L	WindowBase,A0			;Window Base
		MOVEA.L	IntBase,A6			;IntBase
		JSR	-$48(A6)			;Close Window
_CloseScreen	MOVEA.L	ScreenBase,A0			;ScreenBase
		MOVEA.L	IntBase,A6			;IntBase
		JSR	-$42(A6)			;CloseScreen
_CloseGfx	MOVEA.L	GfxBase,A1			;GfxBase
		MOVEA.L	4.W,A6				;ExecBase
		JSR	-$19E(A6)			;Close Library	
_CloseInt	MOVEA.L	IntBase,A1			;IntBase
		MOVEA.L	4.W,A6 				;ExecBase
		JSR	-$19E(A6)			;Close Library
_Error		movem.l	(a7)+,d0-d7/a0-a6		;Return Registers
		rts					;and Exit !

*****************************************************************************
*----------------------- STRUCTURES and DATA -------------------------------*

*-------------- NewScreen Structure
		even
NewScreen	dc.w	0,0,320,276	  ;Left, Top, Width, Height
		dc.w	1		  ;Depth (Number of bitplanes)
		dc.b	0,0		  ;detail , block pen
		dc.w	0,$f+$100	  ;Low-Res,CustomScreen+ScreenQuiet
		dc.l	DefaultFont,0,0,0

*-------------- Font

DefaultFont:	dc.l	FontName
		dc.w	8		;Size
		dc.b	0,0
FontName:	dc.b	'topaz.font',0

*-------------- NewWindow Structure
		even
NewWindow:	dc.w	0,0,320,276
		dc.b	0,0	
		dc.l	0,$1000+$0800+$0100
		dc.l	0,0,0,0,0	
		dc.w	320,276,320,276,$F

*-------------- Library Names

IntName		dc.b	'intuition.library',0
GfxName 	dc.b	'graphics.library',0

*-------------- Pointers
		even
ScreenBase 	dc.l	0			;ScreenBase
WindowBase 	dc.l	0			;WindowBase
IntBase 	dc.l	0			;IntBase
GfxBase 	dc.l	0			;GfxBase

*--------------- Color Map

CMap:		dc.w	$000,$000		;Black, Black		

*-------------- Text Data

Text:		dc.b	'          Fade Text Routine           '
		dc.b	'      Assembler Code written by       '
		dc.b	' Maurice `Digital Dictator` Wielink   '
		dc.b	'   for the Programming Section on     '
		dc.b	'      the Wonderfull and Best         '
		dc.b	'    Disk Magazine on this Earth       '
		dc.b	'             NEWSFLASH                '
;The
 end