opt 	d-

	incdir	"hd:DevPac/include/"
	include	exec/exec.i
	include	exec/exec_lib.i
	include	intuition/intuition.i
	include	intuition/intuition_lib.i
	include	graphics/gfx.i
	include	graphics/graphics_lib.i
	include	libraries/dos.i
	include	libraries/dos_lib.i
	include	libraries/dosextens.i

iff_BMHD.swidth	equ	 8
iff_BMHD.shigh	equ	10
iff_BMHD.pwidth	equ	24
iff_BMHD.phigh	equ	26
iff_BMHD.planes	equ	16
iff_BMHD.xasp	equ	22
iff_BMHD.yasp	equ	23
iff_BODY.length	equ	 4
iff_CAMG.vmode	equ	10

*************************************************************************
*************************************************************************
* Name		: SaveScreen_IFF		Version	: 1.2		*
* Autor		: Merlin/dv-team		Datum	: 21.05.1989	*
*************************************************************************
* Funktion	: schreibt nach Druck auf beide Maustasten den		*
*		  aktuellen Screen auf Disk ins aktuelle Verzeichnis	*
*		  mit Namen 'ScreenCopy' wenn nicht anders angegeben    *
*************************************************************************
* Geschrieben und assembliert mit dem HiSoft/DEVPAC-Assembler           *
*************************************************************************
*************************************************************************

_start		movem.l		d0/a0,-(sp)
		clr.l		returnMsg

		sub.l		a1,a1
		CALLEXEC 	FindTask
		move.l		d0,a4

		tst.l		pr_CLI(a4)
		beq.s		fromWorkbench

		movem.l		(sp)+,d0/a0
		bra		end_startup

fromWorkbench	lea		pr_MsgPort(a4),a0
		CALLEXEC	WaitPort
		lea		pr_MsgPort(a4),a0
		CALLEXEC 	GetMsg
		move.l		d0,returnMsg
		movem.l		(sp)+,d0/a0
end_startup	bsr.s		_main

		move.l		d0,-(sp)

		tst.l		returnMsg
		beq.s		exitToDOS

		CALLEXEC 	Forbid
		move.l		returnMsg(pc),a1
		CALLEXEC 	ReplyMsg

exitToDOS	move.l		(sp)+,d0
		rts

returnMsg	dc.l	0

*->			   Libraries öffnen 			      <-*

_main		lea		intname,a1
		clr.l		d0
		CALLEXEC	OpenLibrary
		move.l		d0,_IntuitionBase
		lea		gfxname,a1
		clr.l		d0
		CALLEXEC	OpenLibrary
		move.l		d0,_GfxBase
		lea		dosname,a1
		clr.l		d0
		CALLEXEC	OpenLibrary
		move.l		d0,_DOSBase

*->	    CON:-Fenster öffnen und Filenamen abfragen		      <-*

		lea		default,a0
		move.l		a0,filename
		move.l		#conname,d1		;WindowName
		move.l		#MODE_NEWFILE,d2	;Modus
		CALLDOS		Open			;öffnen
		move.l		d0,conhandle		;Handle sichern
		move.l		d0,d1
		move.l		#message,d2		;^Textspeicher
		move.l		#msglen,d3		;Länge des Textes
		CALLDOS		Write			;ausgeben
		move.l		conhandle,d1
		move.l		#inbuff,d2		;^EingabeBuffer
		move.l		#30,d3			;max. Länge
		CALLDOS		Read			;lesen
		move.l		d0,-(sp)
		move.l		conhandle,d1
		CALLDOS		Close			;Window schließen
		move.l		(sp)+,d0		
		cmp.l		#1,d0			;wenn keine Eingabe
		beq		loop			;DefaultName
		lea		inbuff,a0
		move.l		a0,filename		;^FileName
		add.l		d0,a0
		sub.l		#1,a0
		move.b		#0,(a0)			;mit 0 terminieren

*->		       Auf DoppelMausKlick warten		      <-*

loop		btst		#6,$bfe001		;linke Taste?
		bne		loop			;nein
		btst		#10,$dff016		;rechte auch?
		bne		loop

*-> 			    Datei öffnen			      <-*

		move.l		filename,d1
		move.l		#MODE_NEWFILE,d2
		CALLDOS		Open
		move.l		d0,handle
		tst.l		d0			;Probleme gehabt?
		beq		error			;ja	

*->			 Adressen ergattern			      <-*

		CALLINT		ViewAddress		;^View
		lea		_camg,a1
		move.l		d0,a0
		move.l		(a0),a0			;^ViewPort -> a0
		move.w		32(a0),iff_CAMG.vmode(a1) ;ViewModes
		move.l		4(a0),colmap		;^ColorMap -> MEM
		move.l		36(a0),a0		;^RasInfo  -> a0
		move.l		4(a0),a0		;^BitMap   -> a0
		move.l		a0,bitmap
		move.w		(a0),d0
		ext.l		d0
		move.l		d0,bytesperrow		;Bytes/Zeile
		lsl.l		#3,d0			;*8 = Pixel
		lea		_bmhd,a1
		move.w		d0,iff_BMHD.swidth(a1)
		move.w		d0,iff_BMHD.pwidth(a1)
		move.w		2(a0),d1
		move.w		d1,iff_BMHD.shigh(a1)	;Zeilen
		move.w		d1,iff_BMHD.phigh(a1)
		clr.l		d2
		sub.l		#1,d1			;wg. DBRA
label1		add.l		d0,d2			;PixelPerPlane
		dbra		d1,label1
		move.b		5(a0),iff_BMHD.planes(a1)	;Depth
		move.b		5(a0),d1
		ext.w		d1
		sub.w		#1,d1
		clr.l		d0
label2		add.l		d2,d0			;PixelTotal
		dbra		d1,label2
		lea		_body,a2
		lsr.l		#3,d0			;BytesTotal
		move.l		d0,iff_BODY.length(a2)	;da soll's hin
		add.l		#headsize,d0
		sub.l		#8,d0
		move.l		d0,_form+4

*->		 die restlichen Preliminarien setzen 		       <-*

		move.b		#11,iff_BMHD.yasp(a1)	;Y-Aspekt
		move.b		#20,d1			;InterLace
		move.w		iff_BMHD.shigh(a1),d0	;Zeilen
		cmp.w		#256,d0
		bgt		is_lace
		move.b		#10,d1			;kein Lace
is_lace		move.w		iff_BMHD.swidth(a1),d0	;Pixel
		cmp.w		#400,d0			;OverScan
							;berücksichtigen
		ble		not_high
		lsr.b		#1,d1			;HIRES: Asp/2
not_high	move.b		d1,iff_BMHD.xasp(a1)	;und speichern

*-> 	   nun geht's auf die Farben los, alle Register übernehmen     <-*

		lea		_cmap,a5		;da ist's sicher
		add.l		#8,a5			;nach ID + length
		move.l		#31,d7			;Zähler
label3		move.l		#31,d0			;#ColReg
		sub.l		d7,d0			,erzeugen
		move.l		colmap,a0
		CALLGRAF	GetRGB4
		move.w		d0,d1
		and.w		#$0f00,d1
		lsr		#4,d1
		move.b		d1,(a5)+		;rot
		move.w		d0,d1
		and.w		#$00f0,d1
		move.b		d1,(a5)+		;grün
		and.w		#$000f,d0
		lsl		#4,d0
		move.b		d0,(a5)+		;blau
		dbra		d7,label3		;next register

*->			was wir haben kann erstmal weg		       <-*

		move.l		handle,d1
		move.l		#_form,d2
		move.l		#headsize,d3
		CALLDOS		Write
		cmp.l		#headsize,d0
		bne		fehler

*-> 		 Zeile für Zeile die BitPlanes zusammenbasteln	       <-*

		lea		_bmhd,a0
		move.w		iff_BMHD.shigh(a0),d7	;Anzahl Zeilen
		sub.w		#1,d7			;wg. DBRA
		move.b		iff_BMHD.planes(a0),d0
		ext.w		d0
		sub.w		#1,d0			;Anz. BitPlanes-1
		move.w		d0,d6			;brauchen wir noch
		move.l		bitmap,a1
		add.l		#8,a1			;^1.BitPlane
		lea		ppoint,a2

label4		move.l		(a1)+,(a2)+
		dbra		d0,label4

label5		lea		_line,a1
		lea		ppoint,a2		;^^BitPlanes
		move.w		d6,d0
label7		move.w		iff_BMHD.swidth(a0),d5
		lsr.w		#3,d5
		sub.w		#1,d5
		move.l		(a2),a3

label6		move.b		(a3)+,(a1)+		;Bytes einer Plane
		dbra		d5,label6		;kopieren

		move.l		a3,(a2)+		;Pointer korrigieren
		dbra		d0,label7		;next plane

		movem.l		d0-d7/a0-a5,-(SP)	;Register retten
		lea		_line,a4
		sub.l		a4,a1
		move.l		a1,d3
		move.l		d3,d6
		move.l		a4,d2
		move.l		handle,d1
		CALLDOS		Write			;Zeile schreiben
		cmp.l		d6,d0
		bne		fehler1
		movem.l		(SP)+,d0-d7/a0-a5

		dbra		d7,label5

*->		 das war's - jetzt alles wieder schließen	       <-*

		move.l		handle,d1
		CALLDOS		Close
errorout	move.l		_DOSBase,a1
		CALLEXEC	CloseLibrary
		move.l		_GfxBase,a1
		CALLEXEC	CloseLibrary
		move.l		_IntuitionBase,a1
		CALLEXEC	CloseLibrary

		move.l		#0,d0
		rts

*-> 			 Hinweis auf Fehler			       <-*

fehler1		movem.l		(SP)+,d0-d7/a0-a5
fehler		move.l		handle,d1
		CALLDOS		Close

error		move.l		#$ffff,d0
err1		move.b		$dff006,$dff180
		dbra		d0,err1
		bra		errorout


***---> 		    Datensegment 			   <---***

_form		dc.b		'FORM'
		dc.l		0
		dc.b		'ILBM'
_bmhd		dc.b		'BMHD'
		dc.l		20			;Länge des BMHD
		ds.b		20
_cmap		dc.b		'CMAP'
		dc.l		96			;Länge der CMAP
		ds.b		96
_camg		dc.b		'CAMG'
		dc.l		4			;Länge der CAMG
		dc.w		0			;Füllword
		dc.w		0			;für ViewMode
_body		dc.b		'BODY'
		dc.l		0			;für Länge
headsize	equ		*-_form

_line		ds.b		320			;1 Zeile

		even

_DOSBase	dc.l		0
_GfxBase	dc.l		0
_IntuitionBase	dc.l		0
handle		dc.l		0
colmap		dc.l		0
bitmap		dc.l		0
bytesperrow	dc.l		0
ppoint		dc.l		0,0,0,0,0,0
filename	dc.l		0
conhandle	dc.l		0

dosname		DOSNAME
intname		INTNAME
gfxname		GRAFNAME
conname		dc.b		'CON:20/10/400/30/Dateinamen eingeben',0
default		dc.b		'ScreenCopy',0
inbuff		ds.b		32
message		dc.b		'<RETURN> für "ScreenCopy"',10
msglen		equ		*-message