; load a picture called 'picture' from drive df1:
; (must already be unpacked), show it and do some
; scrolling in the lower screen
;
; note: the picture must have 5 bitplanes (32 colors)
;	and must be unpacked (e.g. by loading the picture
;	with graphicraft and saving it)
beg:

; ----- graphics.library -----
text= 		-60
setfont= 	-66
closefont=	-78
move= 		-240
initbitmap= 	-390
initrastport= 	-198
clearscreen=	-48
scrollraster=	-396
; ----- exec.library     -----
openlibrary= 	-408
closelibrary= 	-414
forbid= 	-132
permit= 	-138
; ----- diskfont.library -----
openfont= 	-30
; ----- dos.library   	 -----
open=		-30
close=		-36
read=		-42
examine=	-102
; ----- absolute address -----
execbase= 	$04

movem.l 	d0-d7/a0-a6,-(a7)
; ---- open gfx.library -----
move.l		execbase,a6
lea		gfxname,a1
jsr		openlibrary(a6)
move.l		d0,gfxbase
; ---- open dos.library -----
lea		dosname,a1
jsr		openlibrary(a6)
move.l		d0,dosbase
; ---- open diskfont.library -----
lea		diskfontname,a1
jsr		openlibrary(a6)
beq.L		error
move.l		d0,fontlbase
; ---- open required font ... -----
move.l		d0,a6
lea		textattr,a0
jsr		openfont(a6)
beq.L		error
move.l		d0,fontbase
; ---- clear the viewing area ----
move.l		#16000,d0
lea		$55000,a0
clear1:
clr.l		(a0)+
dbra		d0,clear1
; ---- load the picture to 55000 ----
move.l		dosbase,a6
move.l		#1005,d2
move.l		#picname,d1
jsr		open(a6)
move.l		d0,file
move.l		d0,d1
move.l		#$55000-$ba,d2
move.l		#40186,d3
jsr		read(a6)
move.l		file,d1
jsr		close(a6)
; ---- write colors into the clist ----
lea		pic1tab,a0
move.l		#$55000-$ba+$30,a1
move.l		#$00000180,d1
move.l		#$0000001f,d0
coloop1:
move.l		#$02,d2
clr.l		d3
coloop2:
clr.l		d4
move.b		(a1)+,d4
move.l		#$03,d5
coloop3:
roxl.b		#$01,d4
roxl.w		#$01,d3
dbra		d5,coloop3
dbra		d2,coloop2
move.w		d1,(a0)+
move.w		d3,(a0)+
add.w		#$0002,d1
dbra		d0,coloop1
; ---- start it up !!! ----
move.l		execbase,a6
jsr		forbid(a6)
move.l		gfxbase,a0
add.l		#$32,a0
move.w		#$0080,$dff096
move.l		(a0),oldcopper
move.l		#newcopper,(a0)
move.w		#$8080,$dff096
move.l		gfxbase,a6
lea		bitmap,a0
move.l		#$01,d0
move.l		#352,d1
move.l		#15,d2
jsr		initbitmap(a6)
move.l		#$70000,plane1
lea		rastport,a1
jsr		initrastport(a6)
move.l		#bitmap,r_bitmap
lea		rastport,a1
move.l		fontbase,a0
jsr		setfont(a6)
lea		rastport,a1
jsr		clearscreen(a6)
move.l		#scrollmsg,c_ptr
move.w		#$4000,$dff09a
move.l		$6c,oldirq
move.l		#newirq,$6c
move.w		#$c010,$dff09a
bra.L		wait
; ---- the neq irq follows right on ----
newirq:					; Neuer IRQ
movem.l		d0-d7/a0-a6,-(sp)	; Register Retten
; -scrolltext in GrafikSpeicher 1 Punkt nach links 
; -scrollen
; --------------------------------------
move.l		gfxbase,a6		; Routine in GFX-Library
lea		rastport,a1		; Rastport uebergeben
move.l		#0,d2			; linke obere koordinaten des
move.l		#0,d3			; zu verschiebenden rechteck
move.l		#352,d4			; rechte unter koordinaten
move.l		#15,d5			; des rechteck
move.l		#$01,d0			; 1 punkt in x verschieben
clr.l		d1			; kein punkt in y verschieben
jsr		scrollraster(a6)	; verschieben
; --------------------------------------
sub.b		#$01,rows		; schon 1 zeichen (16 punkte)
bne.s		continue1		; gescrollt ???
move.b		#16,rows		; nein
bsr.L		printchar		; neues zeichen ausgeben
continue1:
movem.l		(sp)+,d0-d7/a0-a6
dc.w	$4ef9
oldirq:
dc.l	0

printchar:
; --------------------------------------
move.l		gfxbase,a6	; basis der graphics-library
lea		rastport,a1	; => vorhandenes bitmuster im scroll-
jsr		clearscreen(a6)	; => zwischenspeicher loeschen
lea		rastport,a1	; im zwischenspeicher grafikcursor
move.l		#320,d0		; nach x-position 320
move.l		#15,d1		; und y-pos  	  14 
jsr		move(a6)	; bewegen
lea		rastport,a1     ; in zwischenspeicher
move.l		c_ptr,a0	; zeichen ab adresse (c_ptr)
move.l		#1,d0		; 1 zeichen
jsr		text(a6)	; an position des grafikcursor printen
add.l		#$01,c_ptr	; 1 zum textzeiger addieren
cmp.l		#ende,c_ptr	; ende des textes erreicht ???
bne.s		return		; nein ---
move.l		#scrollmsg,c_ptr; anfang neu setzen
return:				; ruecksprung
rts

wait:
; ---- mouse button, my master ???? ----
btst		#6,$bfe001
bne.s		wait
; ---- stop this great one ----
move.w		#$4010,$dff09a
move.l		oldirq,$6c
move.w		#$c000,$dff09a
move.l		gfxbase,a6
move.l		fontbase,a1
jsr		closefont(a6)
move.l		execbase,a6
move.l		fontlbase,a1
jsr		closelibrary(a6)
move.l		gfxbase,a1
jsr		closelibrary(a6)
move.l		gfxbase,a0
add.l		#$32,a0
move.w		#$0080,$dff096
move.l		oldcopper,(a0)
move.w		#$8080,$dff096
move.l		execbase,a6
jsr		permit(a6)
movem.l		(a7)+,d0-d7/a0-a6
error:
rts

newcopper:			; Neue Copperliste
dc.w 	$008e,$2c81,$0090,$f4c1 ; linke obere/rechte untere 
				; Koordinaten des BildschirmFenster
dc.w 	$0092,$0038,$0094,$00d0 ; DataFetch Start/Stop
dc.w 	$0108,$00a0,$010a,$00a0	; Modulos fuer Grafik
dc.w 	$0102,$0000,$0104,$0000 ; BitPlane Control Reg. #1 u. #2
				; nur wichtig bei DualPlayfield etc.
dc.w 	$0100,$5200		; BitPlane Control Reg. #0
				; 1 Bitplane/Farbe
				; siehe Hardware Reference M. 
				; Anhang A-4			
dc.w    $00e0,$0005,$00e2,$5000	; Zeiger auf Start der Bitplane
dc.w	$00e4,$0005,$00e6,$5028
dc.w 	$00e8,$0005,$00ea,$5050
dc.w 	$00ec,$0005,$00ee,$5078
dc.w	$00f0,$0005,$00f2,$50a0
pic1tab:
blk.b	128,10
dc.w	$e409,$fffe
dc.w 	$0180,$0000,$0182,$0ddd		
dc.w 	$0108,$0004,$010a,$0004	
dc.w 	$0102,$0000,$0104,$0000 
dc.w 	$0100,$1200		
dc.w    $00e0,$0007,$00e2,$0000	


; --------------------------------------
even
scrollmsg:			; Scrolltext
dc.b "HIGH QUALITY CRACKINGS PROUDLY PRESENT A NEW INTRO ",0
ende:

even
gfxbase:
dc.l 	0
dosbase:
dc.l	0
bitmap:
blk.w 	4,0
plane1:
blk.l 	10,0
rastport:
blk.l 	1,0
r_bitmap:
blk.l 	26,0
oldcopper:
dc.l 	0
gfxname:
dc.b 	"graphics.library",0
diskfontname:
dc.b 	"diskfont.library",0
dosname:
dc.b	"dos.library",0
even
fontname:
dc.b 	"tempfont.font",0
even
textattr:
dc.l	fontname
dc.w	14
dc.w	0
fontlbase:
dc.l	0
fontbase:
dc.w	0
rows:
dc.b	0
even
c_ptr:
dc.l	0
file:
dc.l	0
picname:
dc.b	"df1:picture",0
even