****************************************************************************
* VPic (View Picture) V2.00 © 15-06-2002 by Testaware
* --------------------------------------------------------------------------
*
* Code: Volker « Peace » Stepprath
* Home: http://www.testaware.de.tp
*
* CLI/Shell: VPic [file|list|path|#DEC] [0|1] [*|?]
* Workbench: INFO DEFAULT TOOL
*
* DLD: © 1992, 1993 by Georg Hörmann
* XPK: © 1991 Christian Schneider & U.Dominik Mueller
* ABk: François Lionet © Europress Software
* REQ: ReqTools Lib 2.9a © 1991-1997 Nico François & Magnus Holmgren
*
* Assembler: GenAm Macro Assembler V2.11D Copyright © HiSoft 1985,8
* Editor: CygnusEd Professional II © 1987,1988,1989 by CygnusSoft Software
****************************************************************************

		opt	o+,ow-

		Output	RAM:1

		Incdir	DH1:DevPac/Include/

		Include	exec/exec_lib.i
		Include	exec/memory.i
		Include	graphics/graphics_lib.i
		Include	graphics/view.i
		Include	libraries/decrunch_lib.i
		Include	libraries/dos_lib.i
		Include	libraries/dos.i
		Include	libraries/dosextens.i
		Include	libraries/xpk.i
		Include	libraries/reqtools_lib.i
		Include	intuition/intuition.i
		Include	intuition/intuition_lib.i
		Include	intuition/intuitionbase.i
		Include	own/rawkey.i
		Include	workbench/startup.i
		Include	workbench/workbench.i

****************************************************************************
* Strukturanordungen von AmBk Pic.Pac Screen / BitMap
****************************************************************************

;Packed AMOS Screen-Header
		RsReset
PsCode		rs.l	1
PsTx		rs.w	1
PsTy		rs.w	1
PsAWx		rs.w	1
PsAWy		rs.w	1
PsAWTx		rs.w	1
PsAWTy		rs.w	1
PsAVx		rs.w	1
PsAVy		rs.w	1
PsCon0		rs.w	1
PsNbCol		rs.w	1
PsNPlan		rs.w	1
PsPal		rs.w	32
PsLong		equ	__RS
SCCode		equ	$12031990

;Packed AMOS BitMap-Header
		RsReset
Pkcode		rs.l	1
Pkdx		rs.w	1
Pkdy		rs.w	1
Pktx		rs.w	1
Pkty		rs.w	1
Pktcar		rs.w	1
Pknplan		rs.w	1
PkDatas2	rs.l	1
PkPoint2	rs.l	1
PkLong		equ	__RS
PkDatas1	equ	__RS
BMCode		equ	$06071963	;Happy birthday François

;IFF BitMap-HeaDer
		RsReset
ibm_Width	rs.w	1
ibm_Height	rs.w	1
ibm_xPosition	rs.w	1
ibm_yPosition	rs.w	1
ibm_Planes	rs.b	1
ibm_Mask	rs.b	1
ibm_Compression	rs.b	1
ibm_Pad		rs.b	1
ibm_Transparent	rs.w	1
ibm_xAspect	rs.b	1
ibm_yAspect	rs.b	1
ibm_PageWidth	rs.w	1
ibm_PageHeight	rs.w	1
ibm_SIZEOF	equ	__RS

;VPic BitMap-Header
		RsReset
vbm_Code	rs.l	1
vbm_Width	rs.w	1
vbm_Height	rs.w	1
vbm_ViewMode	rs.w	1
vbm_User	rs.w	1
vbm_Bmap	rs.l	1
vbm_Data	equ	__RS
vbm_SIZEOF	equ	__RS
vbm_DEPTH	equ	1
ID_VPIC		equ	$56504943
ID_VBMP		equ	$56424D50

;VPic spezifische Struktur
		RsReset
My_VPicBase	rs.b	0
my_DosBase	rs.l	1
my_IntBase	rs.l	1
my_GfxBase	rs.l	1
my_DcrBase	rs.l	1
my_XpkBase	rs.l	1
my_ReqBase	rs.l	1
my_OutPut	rs.l	1
my_OldLock	rs.l	1
my_FileName	rs.l	1
my_FileLock	rs.l	1
my_FileFib	rs.b	fib_SIZEOF
my_CountFib	rs.b	fib_SIZEOF
my_FileHnd	rs.l	1
my_FileBuf	rs.l	1
my_FileLen	rs.l	1
my_ListBuf	rs.l	1
my_ListLen	rs.l	1
my_PackBuf	rs.l	1
my_PackLen	rs.l	1
my_NewWind	rs.l	nw_SIZE
my_WindPtr	rs.l	1
my_NewScrn	rs.b	ns_SIZEOF
my_ScrnPtr	rs.l	1
my_PlanPtr	rs.l	8
my_Palette	rs.l	1
my_DefPalette	rs.w	32
my_ColorCount	rs.l	1
my_PkMode	rs.b	1
my_FromCLI	rs.b	1
my_KeyCode	rs.b	1
my_CliDisplay	rs.b	1
my_CliScrn	rs.l	1
my_CliWind	rs.l	1
my_NextScrn	rs.l	1
my_AuthPtr	rs.l	1
my_CopyPtr	rs.l	1
my_AnnoPtr	rs.l	1
my_VbmHeader	rs.b	vbm_SIZEOF
my_FmtData	rs.b	256
my_FmtChData	rs.b	1024
my_DataBuf	rs.b	1024
my_InputBuf	rs.b	256
my_RtFileReq	rs.l	1
my_RtInfoReq	rs.l	1
my_RtBut	rs.l	1		;Schalter
my_SIZEOF	rs.w	0

PKMODE_NORMAL		equ	0	;IFF RAW - Unkomprimiert
PKMODE_COMPRESSED	equ	1	;IFF RLE - Komprimiert
PKMODE_AMIGABASIC	equ	2	;IFF ABM - DigiPaint BitMap
PKMODE_AMOSBITMAP	equ	3	;ABK PCK - Amos Packed BitMap
PKMODE_AMOSSCREEN	equ	4	;ABK SPK - Amos Packed Screen
PKMODE_VPICBITMAP	equ	5	;VBM PLN - VPic BitMap Plane
PKMODE_WBOINFO		equ	6	;WBO INF - WorkBench Info
PKMODE_ACTUALSCREEN	equ	7	;ACT SCR - Actual Screen

COLOR_CLI	equ	$FFF
COLOR_OS1	equ	$001
COLOR_OS2	equ	$002
COLOR_RED	equ	$0FF
COLOR_GRN	equ	$F0F
COLOR_BLU	equ	$FF0
COLOR_GRY	equ	$111
COLOR_DEF	equ	$000

****************************************************************************
* Meine Macros
****************************************************************************

LIB		MACRO
		jsr	_LVO\1(a6)
		ENDM

LAB		MACRO
		jmp	_LVO\1(a6)
		ENDM

EXE		MACRO
		movea.l	4.w,a6
		LIB	\1
		ENDM

DOS		MACRO
		movea.l	my_DosBase(a5),a6
		LIB	\1
		ENDM

INT		MACRO
		movea.l	my_IntBase(a5),a6
		LIB	\1
		ENDM

GFX		MACRO
		movea.l	my_GfxBase(a5),a6
		LIB	\1
		ENDM

DCR		MACRO
		movea.l	my_DcrBase(a5),a6
		LIB	\1
		ENDM

XPK		MACRO
		movea.l	my_XpkBase(a5),a6
		LIB	\1
		ENDM

REQ		MACRO
		movea.l	my_ReqBase(a5),a6
		LIB	\1
		ENDM

WAIT		MACRO
		moveq.l	#\1,d1
		bsr	Wait
		ENDM

VPic		bra.s	.0

		dc.b	'$VER: VPic 2.00 FD (15-06-02 21:44:50) '
		dc.b	'©2002 by Volker Stepprath, Testaware'
		cnop	0,4

****************************************************************************
* Test von wo aus das Programm gestartet wurde WB oder CLI/Shell
****************************************************************************

.0		movea.l	a0,a2	;Evtl. Parameter sichern
		move.l	d0,d2

		suba.l	a1,a1
		EXE	FindTask
		movea.l	d0,a4
		tst.l	pr_CLI(a4)
		bne.s	FromCLI

		lea	pr_MsgPort(a4),a0
		LIB	WaitPort
		lea	pr_MsgPort(a4),a0
		LIB	GetMsg
		lea	VPic(pc),a4
		move.l	d0,(a4)

		bsr	OpenAll

		movea.l	VPic(pc),a4
		movea.l	sm_ArgList(a4),a4
		beq	CloseAll

		move.l	wa_Lock(a4),d1
		DOS	CurrentDir

		movea.l	wa_Name+wa_SIZEOF(a4),a0
		bsr	Start

		EXE	Forbid

		movea.l	VPic(pc),a1
		LAB	ReplyMsg

****************************************************************************
* Programm wurde von der CLI/Shell-Ebene aufgerufen
****************************************************************************

FromCLI		movem.l	a2/d2,-(sp)
		bsr	OpenAll
		DOS	Output
		move.l	d0,my_OutPut(a5)
		movem.l	(sp)+,a0/d0

		move.b	#1,my_FromCLI(a5)	;Flag für CLI-Optionen

		subq.l	#1,d0
		ble.s	Rt_ReqLoop		;Kein Param übergeben

;Ein Parameter (irgendwas) wurde angegeben.

.0		cmpi.b	#'?',(a0)		;Syntax anzeigen?
		bne.s	.1
		bsr	Rt_Usage		;Aha, so wird`s gemacht?
		bra	CloseAll

.1		cmpi.b	#'*',(a0)		;Aktuellen Screen darstellen?
		bne.s	.2			;Nö!
		clr.b	(a0,d0)
		move.l	a0,my_FileName(a5)
		move.l	my_CliScrn(a5),my_NextScrn(a5)
		bsr	ASCPic
		bra	CloseAll

.2		cmpi.b	#' ',-2(a0,d0)		;Datei übergeben?
		bne.s	.4			;ÄhÄh

		cmpi.b	#'0',-1(a0,d0)		;In CLI-Window darstellen?
		bne.s	.3			;Nicht nötig!
		move.b	#1,my_CliDisplay(a5)	;Flag setzen
		subq.l	#2,d0			;FileNameLen korrigieren
		bra.s	.4

.3		cmpi.b	#'1',-1(a0,d0)		;In CLI-Wind & Colorset
		bne.s	.4			;Auch nicht!
		move.b	#2,my_CliDisplay(a5)
		subq.l	#2,d0

.4		clr.b	(a0,d0)			;Dateiende mit NULL
		bra.s	Start

;---------------------------------------------------------------------------
;Wurde  VPic  kein  Parameter übergeben, so wird mittels der ReqToolsLib ein
;File-Requester   bereitgestellt   in   welchem  wiederholt  eine  Gfx-Datei
;ausgewählt werden kann.
;---------------------------------------------------------------------------
Rt_ReqLoop	lea	TxRtLoadPIC(pc),a3
		bsr	Rt_Input
		tst.l	my_RtBut(a5)
		beq	CloseAll
		bsr	OpenFile
		bne.s	.1
.0		bsr	IffPic
		beq.s	.1
		bsr	PicDcr
		beq.s	.0
.1		bsr	PrtCLine
		bsr	FreeBuff
		bsr	CKey		;[ESC] betätigt?
		beq	CloseAll	;Ja!
		bra.s	Rt_ReqLoop

****************************************************************************
* Hauptprogramm
****************************************************************************

Start		move.l	a0,my_FileName(a5)

		tst.b	my_FromCLI(a5)
		beq.s	.1		;DEC/Path-Option NUR über CLI/Shell!

		bsr	dec_init	;DirEntryCount-Verfahren?

		bsr.s	LockFile	;Pfad übergeben?
		beq.s	.3		;Ja!

.1		bsr	OpenFile	;Datei öffnen
		bne.s	.3		;Fehler!

.2		bsr	VPicList	;Bilderliste übergeben?
		beq.s	.3		;Ja!
		bsr	IffPic		;IFF/ABk/VBM/WBO-Bild?
		beq.s	.3		;Ja!
		bsr	PicDcr		;Unbekanntes Format! Evtl. entpacken
		beq.s	.2		;Nochmals testen wenn entpackt

.3		bsr	PrtCLine
		bsr	FreeBuff
		bra	CloseAll

****************************************************************************
* Alle Bilder eines Pfades werden angezeigt, nur über CLI! (Param:path)
****************************************************************************

LockFile	move.l	my_FileName(a5),d1
		moveq.l	#ACCESS_READ,d2
		DOS	Lock
		move.l	d0,my_FileLock(a5)
		beq	Error

		move.l	my_FileLock(a5),d1
		lea	my_FileFib(a5),a0
		move.l	a0,d2
		LIB	Examine
		tst.l	d0
		beq.s	.6

		tst.l	my_FileFib+fib_DirEntryType(a5)
		ble.s	.6

		move.l	my_FileLock(a5),d1
		LIB	CurrentDir
		move.l	d0,my_OldLock(a5)

.1		move.l	my_FileLock(a5),d1
		lea	my_FileFib(a5),a0
		move.l	a0,d2
		DOS	ExNext
		tst.l	d0
		beq.s	.5

.2		lea	my_FileFib+fib_FileName(a5),a0
		move.l	a0,my_FileName(a5)
		bsr	OpenFile
		bne.s	.4
.3		bsr	IffPic
		beq.s	.4
		bsr	PicDcr
		beq.s	.3

.4		bsr	FreeBuff

		bsr	CKey		;[ESC] betätigt?
		bne.s	.1		;Nein!

.5		move.l	my_FileLock(a5),d1
		DOS	UnLock

		move.l	my_OldLock(a5),d1
		LIB	CurrentDir
		bra	Ok

.6		bsr.s	.5
		bra	Error

****************************************************************************
* Zeige Bilder aus einer Datenliste (Param:list)
****************************************************************************

VPicList	moveq.l	#0,d0		;Test ob Bilderliste übergeben?
		movea.l	my_FileBuf(a5),a1
		move.l	my_FileLen(a5),d1

;---------------------------------------------------------------------------
;Der  Test  ob es sich um eine Bilderliste handelt ist ein wenig umständlich
;über  ByteCmp  geregelt,  dafür  muß  aber kein ID Header als Erkennung der
;Liste vorangestellt werden.
;---------------------------------------------------------------------------
.1		cmp.b	#10,(a1)	;EndOfLine?
		beq.s	.3		;Ja!
		cmp.b	#32,(a1)
		ble.s	.2		;Ungültiges Zeichen für Dateiname
		cmp.b	#123,(a1)+
		bge.s	.2		;Ebenfalls ungültig
		addq.l	#1,d0
		dbf	d1,.1
.2		bra	Error		;Keine Liste bzw. gepackte Datei
.3		tst.l	d0
		beq	Error

ViewList	move.l	my_FileBuf(a5),my_ListBuf(a5)
		move.l	my_FileLen(a5),my_ListLen(a5)

		move.l	my_ListLen(a5),d0
		movea.l	my_ListBuf(a5),a1

.1		movea.l	a1,a0		;Bildname aus Liste ermitteln
		moveq.l	#0,d1
.2		cmpi.b	#10,(a1)+
		beq.s	.3
		addq.l	#1,d1
		subq.l	#1,d0
		ble.s	.6		;Ende der Liste erreicht?
		bra.s	.2		;Nein!

.3		tst.l	d1		;Freizeile?
		beq.s	.1		;Ja! Überspringen

		movem.l	a1/d0,-(sp)

		clr.b	-1(a1)
		move.l	a0,my_FileName(a5)
		bsr.s	OpenFile
		bne.s	.5

.4		bsr	IffPic		;IFF/ABk/VBM/WBO-Bild?
		beq.s	.5		;Ja!
		bsr	PicDcr		;Evtl. gepackt?
		beq.s	.4		;Ja!

.5		bsr	FreeBuff

		movem.l	(sp)+,a1/d0

		bsr	CKey		;[ESC] betätigt?
		bne.s	.1		;Nein!

.6		movea.l	my_ListBuf(a5),a1
		move.l	my_ListLen(a5),d0
		EXE	FreeMem
		bra	Ok

****************************************************************************
* Bild/Liste öffnen und in Buffer einlesen
****************************************************************************

OpenFile	bsr	PrtView

		move.l	my_FileName(a5),d1
		move.l	#MODE_OLDFILE,d2
		DOS	Open
		move.l	d0,my_FileHnd(a5)
		ble.s	.1

		move.l	my_FileHnd(a5),d1
		moveq	#0,d2
		moveq	#OFFSET_END,d3
		LIB	Seek
		move.l	my_FileHnd(a5),d1
		moveq	#0,d2
		moveq	#OFFSET_BEGINNING,d3
		LIB	Seek
		move.l	d0,my_FileLen(a5)
		ble.s	.1

		move.l	my_FileLen(a5),d0
		moveq	#MEMF_PUBLIC,d1
		EXE	AllocMem
		move.l	d0,my_FileBuf(a5)
		ble.s	.1

		move.l	my_FileHnd(a5),d1
		move.l	my_FileBuf(a5),d2
		move.l	my_FileLen(a5),d3
		DOS	Read
		cmp.l	my_FileLen(a5),d0	;Lesefehler aufgetreten?
		bne.s	.1			;Ja!

		bsr.s	.2
		bra	Ok			;Kein Fehler!

.1		bsr.s	.2
		bsr	PrtVError
		bra	Error			;Fehler!

.2		move.l	my_FileHnd(a5),d1	;Datei immer schließen
		beq.s	.3			;Nicht geöffnet
		clr.l	my_FileHnd(a5)
		DOS	Close
.3		rts

****************************************************************************
* Bildspeicher wieder freigeben
****************************************************************************

FreeBuff	movea.l	my_FileBuf(a5),a1
		move.l	my_FileLen(a5),d0
		beq.s	.0
		clr.l	my_FileLen(a5)
		EXE	FreeMem
.0		rts

****************************************************************************
* Alle benötigten Libraries öffnen, Strukturspeicher reservieren
****************************************************************************

OpenAll		move.l	#my_SIZEOF,d0
		move.l	#MEMF_PUBLIC|MEMF_CLEAR,d1
		EXE	AllocMem
		tst.l	d0
		ble	Error
		movea.l	d0,a5

		lea	my_DosBase(a5),a2

		lea	DosLib(pc),a1
		bsr.s	.0
		lea	IntLib(pc),a1
		bsr.s	.0
		lea	GfxLib(pc),a1
		bsr.s	.0

		movea.l	my_IntBase(a5),a1
		move.l	ib_ActiveScreen(a1),my_CliScrn(a5)
		move.l	ib_ActiveWindow(a1),my_CliWind(a5)
		rts

.0		moveq.l	#0,d0
		LIB	OpenLibrary
		move.l	d0,(a2)+
		rts

****************************************************************************
* Alle geöffneten Libraries schließen und Programm beenden
****************************************************************************

CloseAll	movea.l	my_DosBase(a5),a1
		EXE	CloseLibrary
		movea.l	my_IntBase(a5),a1
		LIB	CloseLibrary
		movea.l	my_GfxBase(a5),a1
		LIB	CloseLibrary

		tst.l	my_DcrBase(a5)
		beq.s	.0
		movea.l	my_DcrBase(a5),a1
		LIB	CloseLibrary

.0		tst.l	my_XpkBase(a5)
		beq.s	.1
		movea.l	my_XpkBase(a5),a1
		LIB	CloseLibrary

.1		tst.l	my_ReqBase(a5)
		beq.s	.3
		move.l	my_RtFileReq(a5),d0
		beq.s	.2
		movea.l	d0,a1
		REQ	rtFreeRequest
.2		movea.l	my_ReqBase(a5),a1
		EXE	CloseLibrary

.3		movea.l	a5,a1
		move.l	#my_SIZEOF,d0
		LIB	FreeMem

		clr.l	d0
		RTS

****************************************************************************
* Zeige das IFF - Format (ILBM/ACBM)
****************************************************************************

IffPic		clr.l	my_AnnoPtr(a5)
		clr.l	my_AuthPtr(a5)
		clr.l	my_CopyPtr(a5)

		clr.w	my_NewScrn+ns_ViewModes(a5)

		movea.l	my_FileBuf(a5),a1	;Datei-Buffer GLOBAL in A1

		moveq.l	#0,d0
.0		cmpi.l	#'BMHD',(a1,d0.l)	;BitMapHeaDer muß sein!
		beq.s	chunk0			;Ja
		addi.l	#2,d0			;Position erhöhen (Word)
		cmpi.l	#1024,d0
		ble.s	.0
		bra	ABkPic			;Nein! Link nächstes Format

;---------------------------------------------------------------------------
;Zunächst  wird  der  für  die  Screen-Darstellung  nötige  Chunk ermittelt.
;Standartmäßig wird anhand der übergebenen Screen-Größe bestimmt, in welchem
;View-Modus dieser geöffnet werden  soll (s. chunk2 'CAMG').  Ebenfalls wird
;hier  ermittelt,  ob  die  IFF-Grafik  im  komprimierten  Zustand vorliegt.
;Kompressionsflag: cmpNone=0 (RAW) / cmpByteRun1=1 (RLE)
;---------------------------------------------------------------------------
chunk0		lea	8(a1,d0.l),a1		;ID_BMHD überspringen
		lea	my_NewScrn(a5),a0
		move.w	ibm_Width(a1),ns_Width(a0)
		move.w	ibm_Height(a1),ns_Height(a0)
		move.b	ibm_Planes(a1),ns_Depth+1(a0)
		move.b	ibm_Compression(a1),my_PkMode(a5)
		clr.w	ns_ViewModes(a0)	;Def. ViewMode installieren
		cmpi.w	#320,ns_Width(a0)
		bls.s	.1
		ori.w	#V_HIRES,ns_ViewModes(a0)
.1		cmpi.w	#256,ns_Height(a0)
		bls.s	.2
		ori.w	#V_LACE,ns_ViewModes(a0)

.2		movea.l	my_FileBuf(a5),a1	;Gfx in A1

;---------------------------------------------------------------------------
;Hier  wird  ermittelt  an  welcher  Position der IFF-Datei die Farbeinträge
;vorliegen.   Falls  kein View-Modus der Grafik übermittelt wurde, wird hier
;anhand der Farbanzahl bestimmt ob die Grafik im HAM-Modus dargestellt wird.
;Unverständlicher  Weise  wird  dieser  Vorgang weder von DPaint IV noch von
;AMOSPro unterstützt, die Folge sind Falschfarben.
;---------------------------------------------------------------------------
chunk1		cmpi.l	#'CMAP',(a1)
		bne.s	chunk2
		lea	4(a1),a2		;Farbtabelle -> A2
		move.l	a2,my_Palette(a5)
		cmpi.l	#$C0,(a2)		;HAM-Modus?
		bne.s	chunk2			;Nein!
		ori.w	#V_HAM,ns_ViewModes(a0)	;HAM-Flag einblenden

;---------------------------------------------------------------------------
;Ein  spezieller  Chunk  für  die  Darstellung  einer  Grafik auf dem Amiga!
;Dieser  ist  von  bedeutung  wenn  die  Grafik  zum  Beispiel  im HAM-Modus
;angezeigt  werden  soll.   Liegt  dieser  Eintrag vor, wird der in chunk0/1
;vorsorglich installierte View-Modus ersetzt.
;---------------------------------------------------------------------------
chunk2		cmpi.l	#'CAMG',(a1)
		bne.s	chunk3
		move.w	10(a1),ns_ViewModes(a0)

;---------------------------------------------------------------------------
;Positionelle  Ermittlung  der  eigentlichen  Grafikdaten.  Erst hier werden
;alle zuvor ermittelten Einstellungen verarbeitet.
;---------------------------------------------------------------------------
chunk3		cmpi.l	#'ABIT',(a1)		;DigiPaint RAW Format?
		bne.s	chunk4			;Nein!
		move.b	#PKMODE_AMIGABASIC,my_PkMode(a5)
		bra.s	IffView			;Grafik zeigen

;--------------------------------------------------------------------------
;Eventuelle    Bemerkungen    ( Annotations )  des   Grafikers   bzw.   des
;Grafikprogramms,  diese  Chunks  können  theoretisch  beliebig  lang sein.
;Übrigens sind  diese Chunks nicht standartmäßig für Grafikdateien gedacht,
;eigentlich verwendet nur das FORM-Musikformat diesen aber Brilliance sowie
;HamLab/ArtPRO usw. unterstützen Annotations ebenso, warum auch nicht VPic!
;--------------------------------------------------------------------------
chunk4		cmpi.l	#'ANNO',(a1)		;Annotation?
		bne.s	chunk5			;Nein
		move.l	a1,my_AnnoPtr(a5)	;Zeiger für Info merken

chunk5		cmpi.l	#'AUTH',(a1)		;Author?
		bne.s	chunk6			;Nein
		move.l	a1,my_AuthPtr(a5)	;Zeiger für Info merken

chunk6		cmpi.l	#'(c) ',(a1)		;Copyright?
		bne.s	chunk7			;Nein
		move.l	a1,my_CopyPtr(a5)	;Zeiger für Info merken

;--------------------------------------------------------------------------
;Die  eigentlichen  Grafikdaten  des  darzustellenden  Bildes.  Diese Daten
;liegen nun gepackt (RunLengthEncoding) oder in Raw-Format vor.
;--------------------------------------------------------------------------
chunk7		cmpi.l  #'BODY',(a1)		;Normales IFF-Format?
		beq.s	IffView			;Ja!
		adda.l	#2,a1			;Zeiger auf nächstes WORD
		bra	chunk1			;Weiter suchen

IffView		lea	8(a1),a4		;Zeiger auf Gfxdaten -> A4

		bsr	PicScrn			;IFF-Screen öffnen
		bne	Error			;Wenn Fehler dann Ende!

		movea.l	my_ScrnPtr(a5),a3
		lea	sc_BitMap(a3),a3

		cmpi.b	#PKMODE_NORMAL,my_PkMode(a5)
		beq.s	IffNorm
		cmpi.b	#PKMODE_COMPRESSED,my_PkMode(a5)
		beq.s	IffPack
		cmpi.b	#PKMODE_AMIGABASIC,my_PkMode(a5)
		beq.s	IffAbas

;---------------------------------------------------------------------------
;Das  IFF-Bild  liegt  unkomprimiert  vor.   Die folgende Routine zeigt wohl
;eines  der  schnellsten  Verfahren,  welches  zum Anzeigen einer IFF-Grafik
;verwendet werden kann.
;---------------------------------------------------------------------------
IffNorm		moveq.l	#0,d3
		moveq.l	#0,d5
		move.w	bm_BytesPerRow(a3),d5
		move.w	bm_Rows(a3),d6
.1		moveq	#0,d4
.2		lea	my_PlanPtr(a5),a0
		move.l	(a0,d4.w),d0
		beq.s	.3
		movea.l	a4,a0
		add.l	d3,d0
		movea.l	d0,a1
		move.l	d5,d0
		EXE	CopyMem
		adda.l	d5,a4
		addq.l	#4,d4
		bra.s	.2
.3		subq.w	#1,d6
		beq.s	IffCols
		add.l	d5,d3
		bra.s	.1

;---------------------------------------------------------------------------
;Das  IFF-Bild liegt komprimiert vor.  Das Kompressionsverfahren muß dem von
;Electronic Arts entwickelten 'cmpByteRun1 (RLE)' entsprechen.
;---------------------------------------------------------------------------
IffPack		move.w	bm_Rows(a3),d6
.0		move.b	bm_Depth(a3),d5
		lea	my_PlanPtr(a5),a1
.1		movea.l	(a1),a0
		move.w	bm_BytesPerRow(a3),d2
.2		move.b	(a4)+,d0
		bmi.s	.4
.3		move.b	(a4)+,(a0)+
		subq.w	#1,d2
		subq.b	#1,d0
		bpl.s	.3
		bra.s	.6
.4		neg.b	d0
		bmi.s	.2
		move.b	(a4)+,d3
.5		move.b	d3,(a0)+
		subq.w	#1,d2
		subq.b	#1,d0
		bpl.s	.5
.6		tst.w	d2
		bne.s	.2
		move.l	a0,(a1)+
		subq.b	#1,d5			;bm_Depth-1
		bne.s	.1
		subq.w	#1,d6			;bm_Rows-1
		bne.s	.0
		bra.s	IffCols

;---------------------------------------------------------------------------
;Die Daten des Bildes liegen im  speziellen DigiPaint (ACBM) Format vor.  In
;diesem Modus kann eine Grafik am schnellsten dargestellt werden. AmigaBASIC
;läßt grüssen!
;---------------------------------------------------------------------------
IffAbas		move.w	bm_BytesPerRow(a3),d7
		mulu	bm_Rows(a3),d7		;Größe der Planes -> D7
		lea	my_PlanPtr(a5),a2
.0		movea.l	a4,a0			;Zeiger Grafikdaten
		move.l	(a2)+,d0		;Zeiger BitPlane
		beq.s	IffCols			;Keine weitere Plane
		movea.l	d0,a1
		move.l	d7,d0
		EXE	CopyMem
		adda.l	d7,a4
		bra.s	.0

;Jetzt noch die benötigte Farbpalette setzten.

IffCols		movea.l	my_Palette(a5),a2
		move.l	(a2)+,d7
		divu	#3,d7
		moveq.l	#0,d6
.0		movea.l	my_ScrnPtr(a5),a0
		lea	sc_ViewPort(a0),a0
		move.l	d6,d0
		moveq.l	#0,d1
		move.b	(a2)+,d1
		lsr.b	#4,d1
		moveq.l	#0,d2
		move.b	(a2)+,d2
		lsr.b	#4,d2
		moveq.l	#0,d3
		move.b	(a2)+,d3
		lsr.b	#4,d3
		GFX	SetRGB4
		addq.l	#1,d6
		dbf	d7,.0

		bra	PicWait

****************************************************************************
* Zeige das spezielle AmBk Pic.Pac - Format (AMOS)
****************************************************************************

ABkPic		cmpi.l	#"AmBk",(a1)		;AMOS Bank?
		bne	VBMPic			;Nein, VPic BitMap Format?

		move.b	#PKMODE_AMOSBITMAP,my_PkMode(a5)
		lea	my_NewScrn(a5),a0

		lea	20(a1),a1		;AmBk Head überspringen
		cmpi.l	#SCCode,(a1)		;AmBk Pic.Pac Screen Format
		bne.s	.1			;Nein! Pack BitMap Format?

;Das Bild wurde mittels 'Spack SCREEN To BANK' gepackt.

		move.b	#PKMODE_AMOSSCREEN,my_PkMode(a5)

		move.w	PsTx(a1),ns_Width(a0)
		move.w	PsTy(a1),ns_Height(a0)
		move.w	PsNPlan(a1),ns_Depth(a0)
		move.w	PsCon0(a1),ns_ViewModes(a0)
		bra.s	.3

.1		cmpi.l	#BMCode,(a1)		;Gepackte BitMap?
		bne	Error			;Nein!

;---------------------------------------------------------------------------
;Es wurden nur die jeweiligen BitMaps mittels 'Pack SCREEN To Bank' gepackt.
;Dabei wird weder die Palette noch der ViewMode berücksichtigt.
;---------------------------------------------------------------------------
		move.w	Pktx(a1),d0
		lsl.w	#3,d0
		move.w	d0,ns_Width(a0)
		move.w	Pkty(a1),d0
		mulu	Pktcar(a1),d0
		move.w	d0,ns_Height(a0)
		move.w	Pknplan(a1),ns_Depth(a0)
		clr.w	ns_ViewModes(a0)	;Def. ViewMode installieren
		cmpi.w	#320,ns_Width(a0)
		bls.s	.2
		ori.w	#V_HIRES,ns_ViewModes(a0)
.2		cmpi.w	#256,ns_Height(a0)
		bls.s	.3
		ori.w	#V_LACE,ns_ViewModes(a0)

.3		bsr	PicScrn			;Screen öffnen
		bne	Error			;Hat nicht geklappt

;---------------------------------------------------------------------------
;Hier  beginnt  nun die eigentliche Unpack-Routine von François Lionet.  Ich
;habe  sie  geringfügig  abändern  müssen,  da  sie  eigentlich  nur für die
;Programmierung eigener AMOSPro Extensionen ausgelegt war.
;---------------------------------------------------------------------------
UAEc		equ	0
UDEc		equ	4
UITy		equ	8
UTy		equ	10
UTLine		equ	12
UNPlan		equ	14
UPile		equ	16

UnPack		move.l	a5,-(sp)

		movea.l	my_FileBuf(a5),a0	;Zeiger auf Bilddaten
		movea.l	my_ScrnPtr(a5),a1	;Zeiger auf Screen

		lea	20(a0),a0		;Header überspringen
		cmpi.b	#PKMODE_AMOSBITMAP,my_PkMode(a5)
		beq.s	.1			;Ist gepackte BitMap!
		lea	PsLong(a0),a0		;Zeiger auf Screen BM

;Parameter preparieren!

.1		lea	-UPile(sp),sp		;Arbeitsbereich einrichten

		lea	sc_BitMap(a1),a1	;Screen BitMap -> A1
		move.w	bm_BytesPerRow(a1),d7
		move.w	Pknplan(a0),UNPlan(sp)	;Anzahl der BitPlanes

		lea	bm_Planes(a1),a1	;Zeiger auf Planes -> A1
		move.l	a1,UAEc(sp)
		move.w	Pktcar(a0),d6		;Höhe gepackten Block -> D6

		move.w	d6,d0
		mulu	d7,d0
		move	d0,UTLine(sp)		;Anzahl der Zeilen

		move.w	Pktx(a0),a3		;Breite BitMap in Bytes -> A3
		subq.w	#1,a3
		move.w	Pkty(a0),UITy(sp)	;Höhe BitMap in Blöcke
		lea	PkDatas1(a0),a4		;Zeiger Tabelle 1 -> A4
		movea.l	a0,a5
		movea.l	a0,a6
		adda.l	PkDatas2(a0),a5		;Zeiger Tabelle 2 -> A5
		adda.l	PkPoint2(a0),a6		;Zeigertabelle -> A6

		moveq	#7,d0
		moveq	#7,d1
		move.b	(a5)+,d2
		move.b	(a4)+,d3
		btst	d1,(a6)
		beq.s	prep
		move.b	(a5)+,d2

prep		subq.w	#1,d1

;BitMaps entpacken!

dplan		movea.l	UAEc(sp),a2		;BitMap PlanePtr -> A2
		addq.l	#4,UAEc(sp)		;Auf nächste Plane
		movea.l	(a2),a2			;Adresse Plane -> A2
		move.w	UITy(sp),UTy(sp)

dligne		movea.l	a2,a1			;PlanePtr -> A1
		move.w	a3,d4

dcarre		movea.l	a1,a0
		move.w	d6,d5			;Blockhöhe

doctet1		subq.w	#1,d5
		bmi.s	doct3
		btst	d0,d2
		beq.s	doct1
		move.b	(a4)+,d3

doct1		move.b	d3,(a0)
		add.w	d7,a0
		dbra	d0,doctet1
		moveq	#7,d0
		btst	d1,(a6)
		beq.s	doct2
		move.b	(a5)+,d2

doct2		dbra	d1,doctet1
		moveq	#7,d1
		addq.l	#1,a6
		bra.s	doctet1

doct3		addq.l	#1,a1			;Auf nächsten Block
		dbra	d4,dcarre
		adda.w	UTLine(sp),a2		;Nächste Blockzeile
		subq.w	#1,UTy(sp)
		bne.s	dligne
		subq.w	#1,UNPlan(sp)
		bne.s	dplan
		lea	UPile(sp),sp		;Arbeitsbereich zurücksetzen

;---------------------------------------------------------------------------
;Die  Farbpalette im Screen setzen.  Die jeweiligen Farbwerte liegen bei dem
;AmBk Format in Word-Größe vor, was die Farbgebung erheblich vereinfacht.
;---------------------------------------------------------------------------
		move.l	(sp)+,a5

		lea	my_NewScrn(a5),a0
		movea.l	my_FileBuf(a5),a1

		lea	20(a1),a1
		cmpi.b	#PKMODE_AMOSBITMAP,my_PkMode(a5)
		beq	PicWait			;Keine Palette (Packed BitMap)

		move.w	PsNbCol(a1),d0		;Anzahl der Farbeinträge
		lea	PsPal(a1),a1		;Zeiger auf Farbtabelle
		movea.l	my_ScrnPtr(a5),a0
		lea	sc_ViewPort(a0),a0
		GFX	LoadRGB4		;Farbwerte aktualisieren

		bra	PicWait

****************************************************************************
* Zeige das (interne) VPic BitMap Plane - Format (VPIC/VBMP)
****************************************************************************

VBMPic		cmpi.l	#ID_VBMP,vbm_Bmap(a1)	;VPic BitMap Format?
		bne.s	WBOPic			;Nein

		move.b	#PKMODE_VPICBITMAP,my_PkMode(a5)

		lea	my_NewScrn(a5),a0
		move.w	vbm_Width(a1),ns_Width(a0)
		move.w	vbm_Height(a1),ns_Height(a0)
		move.w	#vbm_DEPTH,ns_Depth(a0)
		move.w	vbm_ViewMode(a1),ns_ViewModes(a0)

		bsr	PicScrn			;Screen öffnen
		bne	Error			;Hat nicht geklappt

		movea.l	my_FileBuf(a5),a0	;Zeiger auf Bilddaten
		lea	vbm_Data(a0),a0

		moveq.l	#0,d0
		movea.l	my_ScrnPtr(a5),a1	;Zeiger auf Screen
		lea	sc_BitMap(a1),a1
		move.w	bm_BytesPerRow(a1),d0
		mulu	bm_Rows(a1),d0
		movea.l	my_PlanPtr(a5),a1
		EXE	CopyMem

		bra	PicWait

****************************************************************************
* Zeige das Workbench Objekt Info - Format ($E310 0001)
****************************************************************************

WBOPic		cmpi.w	#WB_DISKMAGIC,do_Magic(a1)	;WBO Info Format?
		bne	Error				;Nein! Decrunch
		cmpi.w	#WB_DISKVERSION,do_Version(a1)
		bne	Error

		move.b	#PKMODE_WBOINFO,my_PkMode(a5)

		lea	my_NewScrn(a5),a0
		movea.l	my_FileBuf(a5),a1
		lea	do_Gadget(a1),a1
		move.w	#640,ns_Width(a0)
		move.w	gg_Height(a1),ns_Height(a0)
		move.w	#2,ns_Depth(a0)
		move.w	#V_HIRES,ns_ViewModes(a0)
		bsr	PicScrn				;Screen öffnen
		bne	Error				;Hat nicht geklappt

		moveq.l	#0,d6
		moveq.l	#0,d7
		movea.l	my_FileBuf(a5),a4
		lea	do_Gadget(a4),a1
		move.w	gg_Width(a1),d6
		move.w	gg_Height(a1),d7
		move.l	d6,d0				;kgV 16
		divu	#$10,d0
		swap	d0
		andi.l	#$FFFF,d0
		tst.w	d0
		beq.s	.0
		sub.l	d0,d6
		addi.l	#$10,d6

.0		tst.w	do_DrawerData(a4)
		bne.s	.1
		adda.l	#98,a4
		bra.s	.2
.1		adda.l	#154,a4

.2		lsr.l	#3,d6
		moveq.l	#0,d4

WBO_View	movea.l	my_PlanPtr(a5),a3
		bsr.s	.0
		movea.l	my_PlanPtr+4(a5),a3
		bsr.s	.0
		tst.l	d4
		bne	PicWait
		adda.l	#20,a4
		move.l	d6,d4
		bra.s	WBO_View

.0		adda.l	d4,a3
		move.l	d7,d5
		subq	#2,d5
.1		movea.l	a4,a0
		movea.l	a3,a1
		move.l	d6,d0
		EXE	CopyMem
		adda.l	d6,a4
		adda.l	#80,a3
		dbra	d5,.1
		rts

****************************************************************************
* Zeige den aktuellen Screen - [Param:*] [RETURN]
****************************************************************************

ASCPic		move.b	#PKMODE_ACTUALSCREEN,my_PkMode(a5)

		move.l	my_NextScrn(a5),a0		;Nächster Screen
		move.l	(a0),my_NextScrn(a5)		;übergeben

		tst.l	my_NextScrn(a5)
		bne.s	.0
		move.l	my_CliScrn(a5),my_NextScrn(a5)

.0		movea.l	my_NextScrn(a5),a0
		lea	my_NewScrn(a5),a1
		move.w	sc_Width(a0),ns_Width(a1)
		move.w	sc_Height(a0),ns_Height(a1)
		lea	sc_ViewPort(a0),a2
		move.w	vp_Modes(a2),ns_ViewModes(a1)
		lea	sc_BitMap(a0),a0
		move.b	bm_Depth(a0),ns_Depth+1(a1)
		bsr	PicScrn
		bne	Error

		movea.l	my_NextScrn(a5),a3
		movea.l	my_ScrnPtr(a5),a4
		lea	sc_BitMap(a3),a3
		lea	sc_BitMap(a4),a4

		moveq.l	#0,d7
		move.w	bm_BytesPerRow(a4),d7
		mulu	bm_Rows(a4),d7

;Die aktuellen ScrnPlanes in die ScrnPlanes kopieren

.1		move.l	bm_Planes(a3),d0
		beq.s	.2
		move.l	bm_Planes(a4),d1
		beq.s	.2
		movea.l	d0,a0
		movea.l	d1,a1
		move.l	d7,d0
		EXE	CopyMem
		adda.l	#4,a3
		adda.l	#4,a4
		bra.s	.1

;Farben setzen

.2		movea.l	my_NextScrn(a5),a1
		lea	sc_ViewPort(a1),a1
		movea.l	vp_ColorMap(a1),a1
		movea.l	cm_ColorTable(a1),a1

		movea.l	my_ScrnPtr(a5),a0
		lea	sc_ViewPort(a0),a0
		move.l	my_ColorCount(a5),d0
		GFX	LoadRGB4

;Screen aufblinken für Darstellungsinfo

		bsr	PicFront
		move.l	my_ScrnPtr(a5),a0
		INT	DisplayBeep
		WAIT	10			;Warten auf ColorCorrection

		lea	my_InputBuf(a5),a0	;Für Info (*)
		move.w	#$2A00,(a0)
		move.l	a0,my_FileName(a5)

		bra	PicWait

****************************************************************************
* Unter-Routinen die für jedes Bildformat gleichbedeutend sind
****************************************************************************

PicScrn		lea	my_NewScrn(a5),a0
		move.w	#CUSTOMSCREEN|SCREENBEHIND,ns_Type(a0)
		INT	OpenScreen
		move.l	d0,my_ScrnPtr(a5)
		beq	Error

		movea.l	d0,a0			;PlanePtr kopieren
		lea	sc_BitMap(a0),a0
		lea	bm_Planes(a0),a0
		lea	my_PlanPtr(a5),a1
		moveq.l	#8-1,d0
.0		move.l	(a0)+,(a1)+
		dbra	d0,.0

		lea	my_NewWind(a5),a0
		lea	my_NewScrn(a5),a1

		move.w	ns_Depth(a1),d0		;Farbanzahl merken
		moveq.l	#0,d1
		bset	d0,d1
		move.l	d1,my_ColorCount(a5)

		move.w	ns_Width(a1),nw_Width(a0)
		move.w	ns_Height(a1),nw_Height(a0)
		move.l	#MOUSEBUTTONS|RAWKEY,nw_IDCMPFlags(a0)
		move.l	#ACTIVATE|BORDERLESS,nw_Flags(a0)
		move.l	my_ScrnPtr(a5),nw_Screen(a0)
		move.w	#CUSTOMSCREEN,nw_Type(a0)
		LIB	OpenWindow
		move.l	d0,my_WindPtr(a5)
		bne	Ok
		bsr	PicClose
		bra	Error

PicWait		movea.l	my_ScrnPtr(a5),a0	;Farben kopieren für *Shade
		lea	sc_ViewPort(a0),a0
		movea.l	vp_ColorMap(a0),a1
		movea.l	cm_ColorTable(a1),a1
		lea	my_DefPalette(a5),a0
		moveq.l	#32-1,d0
.0		move.w	(a1)+,(a0)+
		dbf	d0,.0

		tst.b	my_CliDisplay(a5)	;Bild zeigen im CLI-Window?
		bne	CliDisplay		;Ja

		bsr	PicFront

		movea.l	my_WindPtr(a5),a0
		movea.l	wd_UserPort(a0),a0
		move.b	MP_SIGBIT(a0),d1
		moveq.l	#0,d0
		bset	d1,d0
		EXE	Wait

PicKey		WAIT	5
		bsr	CKey
		beq.s	.0		;[ESC] = Abbruch
		move.b	my_KeyCode(a5),d1
		beq.s	PicKey
		cmpi.b	#$FF,d1
		beq.s	.0
		bra.s	.1
.0		bsr	PicBack
		bra	WinClose

;Auswertung der Tastatureingaben

.1		cmpi.b	#RAW_F1,d1	;[F1] = Info
		bne.s	.2
		bsr	PicBack
		bsr	PicInfo
		bsr	PicFront
		bra.s	PicKey

.2		cmpi.b	#RAW_F2,d1	;[F2] = Save IFF
		bne.s	.3
		bsr	PicBack
		bsr	SaveIFF
		bsr	PicFront
		bra.s	PicKey

.3		cmpi.b	#RAW_F3,d1	;[F3] = Negative
		bne.s	.4
		bsr	Negative
		bra.s	PicKey

.4		cmpi.b	#RAW_F4,d1	;[F4] = CLI Display
		bne.s	.5
		bsr	PicBack
		bra	CliDisplay

.5		cmpi.b	#RAW_F5,d1	;[F5] = CLI Display + Colorset
		bne.s	.6
		bsr	PicBack
		bsr	CliDisplay
		move.w	#COLOR_CLI,d3
		bsr	Shade
		bra	Ok

.6		cmpi.b	#RAW_F6,d1	;[F6] = Red Shade
		bne.s	.7
		move.l	#COLOR_RED,d3
		bsr	Shade
		bra	PicKey

.7		cmpi.b	#RAW_F7,d1	;[F7] = Green Shade
		bne.s	.8
		move.l	#COLOR_GRN,d3
		bsr	Shade
		bra	PicKey

.8		cmpi.b	#RAW_F8,d1	;[F8] = Blue Shade
		bne.s	.9
		move.l	#COLOR_BLU,d3
		bsr	Shade
		bra	PicKey

.9		cmpi.b	#RAW_F9,d1	;[F9] = Grey Shade
		bne.s	.10
		move.l	#COLOR_GRY,d3
		bsr	Shade
		bra	PicKey

.10		cmpi.b	#RAW_F10,d1	;[F10] = Def Palette
		bne.s	.11
		moveq.l	#COLOR_DEF,d3
		bsr	Shade
		bra	PicKey

.11		cmpi.b	#RAW_HELP,d1	;[HELP] = Usage
		bne.s	.12
		bsr	PicBack
		bsr	Rt_Usage
		bsr	PicFront
		bra	PicKey

.12		cmpi.b	#RAW_1,d1	;[1-8] = Save VBM
		bmi.s	.13
		cmpi.b	#RAW_9,d1
		bpl.s	.13
		bsr.s	PicBack
		bsr	SaveVBM
		bsr	PicFront
		bra	PicKey

.13		cmpi.b	#RAW_RETURN,d1	;[RETURN] = View Next Screen
		bne.s	.14
		bsr.s	PicBack
		bsr.s	WinClose
		bra	ASCPic

.14		cmpi.b	#RAW_RALT,d1	;[RALT] = Multitasking
		bne.s	.15
		bsr.s	PicBack
.Loop		WAIT	10
		bsr	CKey
		cmpi.b	#RAW_LALT,d1	;[LALT] = Stop multitasking
		bne.s	.Loop
		bsr.s	PicFront
		bra	PicKey

.15		cmpi.b	#RAW_N1,d1	;[N1] = Set OS1.3 color
		bne.s	.16
		moveq.l	#COLOR_OS1,d3
		bsr	Shade
		bra	PicKey

.16		cmpi.b	#RAW_N2,d1	;[N2] = Set OS2.0 color
		bne.s	.99
		moveq.l	#COLOR_OS2,d3
		bsr	Shade
		bra	PicKey

.99		cmpi.b	#RAW_SPACE,d1	;[SPACE] = End
		bne	PicKey

WinClose	movea.l	my_WindPtr(a5),a0
		INT	CloseWindow

PicClose	movea.l	my_ScrnPtr(a5),a0
		INT	CloseScreen

		bra	Ok

PicBack		movea.l	my_ScrnPtr(a5),a0
		INT	ScreenToBack
		rts

PicFront	movea.l	my_ScrnPtr(a5),a0
		INT	ScreenToFront
		rts

****************************************************************************
* Informationen der dargestellten Grafik ausgeben - [F1]
****************************************************************************

PicInfo		lea	my_NewScrn(a5),a0
		lea	my_FmtData(a5),a1
		move.l	my_FileName(a5),a2
		movea.l	a2,a3
.0		cmpi.b	#':',(a2)		;Nur den Dateinamen
		beq.s	.1
		cmpi.b	#'/',(a2)
		beq.s	.1
		tst.b	(a2)+
		bne.s	.0
		bra.s	PicInfoOut
.1		adda.l	#1,a2
		movea.l	a2,a3
		bra.s	.0

PicInfoOut	move.l	a3,(a1)+
		move.w	ns_Width(a0),(a1)+
		move.w	ns_Height(a0),(a1)+
		move.w	ns_Depth(a0),(a1)+
		move.l	my_ColorCount(a5),(a1)+
		move.w	ns_ViewModes(a0),(a1)+
		move.b	my_PkMode(a5),d0
		ext.w	d0
		lsl.w	#4,d0
		lea	TxTyp(pc),a0
		lea	(a0,d0),a0
		move.l	a0,(a1)+
		move.l	my_FileLen(a5),(a1)+

		clr.l	(a1)
		clr.l	4(a1)
		clr.l	8(a1)

		lea	TxAnno(pc),a2
		clr.w	(a2)
		lea	TxAuth(pc),a2
		clr.w	(a2)
		lea	TxCopy(pc),a2
		clr.w	(a2)

		move.l	my_CopyPtr(a5),d0
		beq.s	.0
		move.l	#'(c) ',d1
		bsr.s	.3
		lea	TxAuth(pc),a2

.0		move.l	my_AuthPtr(a5),d0
		beq.s	.1
		move.l	#'Auth',d1
		bsr.s	.3
		lea	TxAnno(pc),a2

.1		move.l	my_AnnoPtr(a5),d0
		beq.s	.2
		move.l	#'Anno',d1
		bsr.s	.3

.2		lea	TxInfo(pc),a0
		bsr	Rt_Fmt
		lea	my_DataBuf(a5),a4
		move.l	a0,8(a4)
		lea	TxRtPicInfo(pc),a0
		move.l	a0,(a4)
		lea	TxRtOKCOLS(pc),a0
		move.l	a0,4(a4)
		bsr	Rt_Request
		tst.l	my_RtBut(a5)
		beq	Ok
		bra.s	ColorTable

.3		move.b	#10,(a2)+
		move.l	d1,(a2)
		movea.l	d0,a0
		lea	4(a0),a0
		move.l	(a0)+,d0
		clr.b	(a0,d0)
		move.l	a0,(a1)+
		rts

ColorTable	movea.l	my_ScrnPtr(a5),a4
		lea	sc_ViewPort(a4),a3
		movea.l	vp_ColorMap(a3),a3
		movea.l	cm_ColorTable(a3),a3
		lea	my_FmtData(a5),a4
		move.l	my_ColorCount(a5),d0
		cmpi.l	#64,d0			;AGA ist >64 (256 RGB)
		ble.s	.NoAGA			;Kein AGA Format
		move.l	#64,d0			;8 BMP ist viel zu viel
.NoAGA		subq.w	#1,d0
		moveq	#0,d1
		moveq	#0,d2
		lea	my_DataBuf(a5),a2
.0		move.w	d1,(a4)
		move.w	(a3)+,2(a4)
		addq.w	#1,d1
		lea	TxColMap(pc),a0
		bsr	Rt_Fmt
.1		move.b	(a0)+,(a2)+
		bne.s	.1
		suba.l	#1,a2
		addq.b	#1,d2
		cmpi.b	#4,d2
		bne.s	.2
		moveq	#0,d2
		move.b	#10,(a2)+		;Neue Zeile
.2		dbeq	d0,.0
		clr.b	-1(a2)			;Ende der Farbtabelle
		lea	my_FmtData(a5),a4	;Buffer wird nicht benötigt!
		lea	TxRtColorTab(pc),a0
		move.l	a0,(a4)
		lea	TxRtOKINFO(pc),a0
		move.l	a0,4(a4)
		lea	my_DataBuf(a5),a0
		move.l	a0,8(a4)
		bsr	Rt_Request
		clr.l	my_DataBuf(a5)		;Für Dateinamen (löschen)
		tst.l	my_RtBut(a5)
		bne	PicInfo
		bra	Ok

****************************************************************************
* Zur Zeit dargestelltes Bild als IFF-Datei speichern - [F2]
****************************************************************************

SaveIFF		lea	TxRtSaveIFF(pc),a3
		bsr	Rt_Input
		tst.l	my_RtBut(a5)
		beq	Ok

		move.l	my_FileName(a5),d1
		move.l	#MODE_NEWFILE,d2
		DOS	Open
		move.l	d0,my_FileHnd(a5)
		ble	PrtSError

		lea	my_DataBuf(a5),a3	;1024 Bytes löschen
		move.l	#255,d0
.0		clr.l	(a3)+
		dbf	d0,.0

;---------------------------------------------------------------------------
;Der  Haupt-Chunk.   Hier  werden  alle  nötigen Daten zur Screen-Verwaltung
;installiert.
;---------------------------------------------------------------------------
CreateBMHD	lea	TxBMHD+8(pc),a3
		lea	my_NewScrn(a5),a1
		move.w	ns_Width(a1),ibm_Width(a3)
		move.w	ns_Height(a1),ibm_Height(a3)
		move.b	ns_Depth+1(a1),ibm_Planes(a3)
		clr.b	ibm_Compression(a3)
		move.b	#$A,ibm_xAspect(a3)
		move.b	#$B,ibm_yAspect(a3)
		move.w	ns_Width(a1),ibm_PageWidth(a3)
		move.w	ns_Height(a1),ibm_PageHeight(a3)

		lea	TxBODY(pc),a3
		move.w	ns_Width(a1),d0
		and.l	#$FFFF,d0
		lsr.w	#3,d0			;Durch 8 teilen
		mulu	ns_Height(a1),d0
		mulu	ns_Depth(a1),d0
		move.l	d0,4(a3)		;BODY-Größe merken

;---------------------------------------------------------------------------
;Erstellung   des   IFF-ViewModes.    Von  vielen  Grafikprogrammen  einfach
;vernachlässigt.   Man  kann  den ViewMode zwar über den BMHD ermitteln, bei
;HAM-Grafiken aber würde es unweigerlich zu Schwierigkeiten führen.
;---------------------------------------------------------------------------
CreateCAMG	lea	TxCAMG(pc),a3
		movea.l	my_ScrnPtr(a5),a4
		lea	sc_ViewPort(a4),a0
		move.w	vp_Modes(a0),10(a3)

;Farbwerte ermitteln und als RGB Chunk-Daten eintragen.

CreateCMAP	lea	TxBMHD+8(pc),a3		;ID_BMHD+Len überspringen
		move.b	ibm_Planes(a3),d0	;Anzahl der Planes
		moveq.l	#0,d1
		bset	d0,d1
		move.l	d1,d5			;Farbanzahl merken
		mulu	#3,d1
		moveq.l	#0,d6
		lea	my_DataBuf(a5),a3
.1		movea.l	sc_ViewPort+vp_ColorMap(a4),a0
		move.l	d6,d0
		GFX	GetRGB4
		move.l	d0,d1
		bmi.s	.2
		andi.w	#$F00,d0
		lsr.w	#4,d0
		move.b	d0,(a3)+		;Rot
		move.l	d1,d0
		andi.b	#$F0,d1
		move.b	d1,(a3)+		;Grün
		andi.b	#$F,d0
		lsl.b	#4,d0
		move.b	d0,(a3)+		;Blau
		addq.l	#1,d6
		dbf	d5,.1
.2		lea	TxCMAP(pc),a3
		btst	#0,d6			;Farbanzahl ungerade?
		beq.s	.3			;Nein!
		addq.l	#1,d6
.3		mulu	#3,d6
		move.l	d6,4(a3)

;---------------------------------------------------------------------------
;Die  IFF-Head  Größe  wird ermittelt.  Dazu  werden nur  noch die variablen
;Chunk-Größen von CMAP und BODY addiert.
;---------------------------------------------------------------------------
CreateBODY	lea	TxFORM(pc),a3
		move.l	#TxFormL,d7	;Inklusive BODY+LEN (FORM+LEN)
		add.l	TxCMAP+4(pc),d7
		add.l	TxBODY+4(pc),d7
		move.l	d7,d6
		move.l	d6,4(a3)

;Nun den IFF-Header speichern.

SaveHEAD	move.l	my_FileHnd(a5),d1
		move.l	a3,d2
		move.l	#TxFormL,d3
		DOS	Write

SaveCMAP	move.l	my_FileHnd(a5),d1
		lea	my_DataBuf(a5),a0
		move.l	a0,d2
		move.l	TxCMAP+4(pc),d3
		LIB	Write

SaveBODY	move.l	my_FileHnd(a5),d1
		lea	TxBODY(pc),a0
		move.l	a0,d2
		moveq.l	#8,d3
		LIB	Write

;Hier werden die eigentlichen Grafikdaten im cmpNone Verfahren gespeichert.

MakeBODY	movea.l	my_ScrnPtr(a5),a3
		lea	sc_BitMap(a3),a3
		move.w	bm_BytesPerRow(a3),d5
		and.l	#$FFFF,d5
		move.w	bm_Rows(a3),d6
		moveq.l	#0,d7
.1		moveq.l	#bm_Planes,d4
.2		move.l	(a3,d4.l),d0
		beq.s	.3
		move.l	my_FileHnd(a5),d1
		move.l	d0,d2
		add.l	d7,d2
		move.l	d5,d3
		LIB	Write
		addq.l	#4,d4
		bra.s	.2
.3		add.l	d5,d7
		subq.w	#1,d6
		bne.s	.1

CloseIFF	move.l	my_FileHnd(a5),d1
		clr.l	my_FileHnd(a5)
		LIB	Close

EndSaveIFF	bra	PrtULine

****************************************************************************
* Bild als Negativ darstellen - [F3]
****************************************************************************

Negative	moveq.l	#0,d5
		moveq.l	#0,d6
		movea.l	my_ScrnPtr(a5),a3
		lea	sc_BitMap(a3),a3
		move.w	bm_BytesPerRow(a3),d1
		move.w	bm_Rows(a3),d2

.0		move.l	bm_Planes(a3),d0
		beq.s	.2
		movea.l	d0,a0
		move.l	d1,d0
		mulu	d2,d0
.1		not.l	(a0)+
		subq.l	#4,d0
		bne.s	.1
		adda.l	#4,a3
		bra.s	.0

.2		WAIT	50
		rts

****************************************************************************
* Bild in aktuelles CLI-Window darstellen [Param:0|1] [F4|F5]
****************************************************************************

CliDisplay	tst.b	my_FromCLI(a5)
		beq	Ok

;Die jeweiligen ScrnPtr bzw. BitMaps angeben

		movea.l	my_ScrnPtr(a5),a3
		lea	sc_BitMap(a3),a3
		movea.l	my_CliScrn(a5),a4
		lea	sc_BitMap(a4),a4

		moveq.l	#0,d6
		moveq.l	#0,d7
		move.w	bm_BytesPerRow(a3),d6
		mulu	bm_Rows(a3),d6
		move.w	bm_BytesPerRow(a4),d7
		mulu	bm_Rows(a4),d7
		cmp.l	d6,d7
		ble.s	.0
		move.l	d6,d7

.0		bsr	CliMaxWind
		move.w	bm_Rows(a3),d6
		lsr.w	#3,d6
		addq.w	#2,d6
		cmpi.w	#31,d6
		ble.s	.1
		move.w	#31,d6
.1		move.w	d6,my_FmtData(a5)
		bsr	PrtLLine

;Die ScrnPlanes in die aktuellen CLI-ScrnPlanes kopieren

CopyCliPln	move.l	bm_Planes(a3),d0
		beq.s	.1
		move.l	bm_Planes(a4),d1
		beq.s	.1
		movea.l	d0,a0
		movea.l	d1,a1
		move.l	d7,d0
		EXE	CopyMem
		adda.l	#4,a3
		adda.l	#4,a4
		bra.s	CopyCliPln

.1		cmpi.b	#1,my_CliDisplay(a5)
		beq.s	.2

		cmpi.b	#2,my_CliDisplay(a5)
		bne.s	.2

		move.l	#COLOR_CLI,d3
		bsr.s	Shade
.2		bra	WinClose

****************************************************************************
* Farben in Rot/Grün/Blau/Grau/Def/OS1/OS2-Töne wandeln [F6-F10|N1|N2]
****************************************************************************

Shade		cmpi.w	#COLOR_CLI,d3		;CLI-Scrn Color
		bne.s	.0
		movea.l	my_CliScrn(a5),a0
		moveq.l	#COLOR_DEF,d3
		bra.s	.1

.0		movea.l	my_ScrnPtr(a5),a0

.1		lea	sc_ViewPort(a0),a0

GetColTab	movea.l	vp_ColorMap(a0),a1
		movea.l	cm_ColorTable(a1),a1
		movea.l	a1,a2

		move.l	my_ColorCount(a5),d0

		cmpi.w	#COLOR_DEF,d3		;Default
		beq.s	.1
		cmpi.w	#COLOR_OS1,d3		;OS.13
		bne.s	.0
		moveq	#4,d0
		lea	Col13(pc),a1
		bra.s	ColSet
.0		cmpi.w	#COLOR_OS2,d3		;OS2.0
		bne.s	ColClc
		moveq	#4,d0
		lea	Col20(pc),a1
		bra.s	ColSet

.1		lea	my_DefPalette(a5),a1
		bra.s	ColSet

ColClc		move.w	d0,d1
		andi.l	#$FFF,d3
.1		moveq.l	#0,d2
		move.w	(a2),d2
		cmpi.w	#COLOR_GRY,d3		;Grey
		bne.s	.2
		divu	d3,d2
		swap	d2
		bra.s	.3
.2		and.w	d3,d2
.3		sub.w	d2,(a2)+
		dbf	d1,.1

ColSet		GFX	LoadRGB4		;Farbwerte aktualisieren
		rts

Col13		dc.w	$05A,$FFF,$000,$F80
Col20		dc.w	$999,$000,$FFF,$68B

****************************************************************************
* Bild in VPic BitMap - Format speichern [1-8]
****************************************************************************

SaveVBM		moveq.l	#0,d0
		move.b	my_KeyCode(a5),d0
		subq.b	#1,d0
		lsl.w	#2,d0
		movea.l	my_ScrnPtr(a5),a0
		lea	sc_BitMap(a0),a0
		lea	bm_Planes(a0),a0
		move.l	(a0,d0.l),d0		;Plane[1-8] belegt
		beq	Ok			;Nein! aber kein Fehler

;Zu speichernde Bitmap-Addresse übergeben

		move.l	d0,my_PlanPtr(a5)

;Dateiname über ReqToolsFileRequest bestimmen

		lea	TxRtSaveVBM(pc),a3
		bsr	Rt_Input
		tst.l	my_RtBut(a5)
		beq	Ok

OpenVBM		move.l	my_FileName(a5),d1
		move.l	#MODE_NEWFILE,d2
		DOS	Open
		move.l	d0,my_FileHnd(a5)
		ble	PrtSError

;Header einrichten & speichern

		moveq.l	#0,d0
		lea	my_VbmHeader(a5),a3
		move.l	#ID_VPIC,vbm_Code(a3)
		move.l	#ID_VBMP,vbm_Bmap(a3)
		movea.l	my_ScrnPtr(a5),a4
		lea	sc_ViewPort(a4),a0
		move.w	vp_Modes(a0),vbm_ViewMode(a3)
		lea	sc_BitMap(a4),a1
		move.w	bm_BytesPerRow(a1),d0
		lsl.w	#3,d0
		move.w	d0,vbm_Width(a3)
		move.w	bm_Rows(a1),vbm_Height(a3)
		move.l	my_FileHnd(a5),d1
		move.l	a3,d2
		moveq	#vbm_SIZEOF,d3
		LIB	Write

;Plane [1-8] speichern

		moveq.l	#0,d0
		moveq.l	#0,d3
		move.l	my_FileHnd(a5),d1
		move.l	my_PlanPtr(a5),d2
		move.w	vbm_Width(a3),d0
		move.w	vbm_Height(a3),d3
		lsr.w	#3,d0
		mulu	d0,d3
		LIB	Write

CloseVBM	move.l	my_FileHnd(a5),d1
		clr.l	my_FileHnd(a5)
		LIB	Close

EndVBM		bra	PrtULine

****************************************************************************
* CLI-Window auf max. Größe & Rahmen löschen
****************************************************************************

CliMaxWind	tst.b	my_FromCLI(a5)
		beq	Ok

		movem.l	a0-a6/d0-d2,-(sp)
		movea.l	my_CliWind(a5),a0
		move.b	#0,wd_BorderLeft(a0)
		move.b	#0,wd_BorderTop(a0)
		move.b	#0,wd_BorderRight(a0)
		move.b	#0,wd_BorderBottom(a0)
		moveq	#0,d0
		moveq	#0,d1
		moveq	#0,d2
		move.w	wd_LeftEdge(a0),d2
		sub.l	d2,d0
		move.w	wd_TopEdge(a0),d2
		sub.l	d2,d1
		INT	MoveWindow
		move.l	#$280,d0
		move.l	#$100,d1
		move.w	wd_Width(a0),d2
		sub.l	d2,d0
		move.w	wd_Height(a0),d2
		sub.l	d2,d1
		LIB	SizeWindow
		WAIT	5
		movea.l	my_CliWind(a5),a0
		movea.l	wd_RPort(a0),a1
		moveq	#0,d0
		GFX	SetRast
		WAIT	5
		movem.l	(sp)+,a0-a6/d0-d2
		rts

****************************************************************************
* Falls  Bildformat mit  einem  Datenpacker  ge'crunch't  ist,  mittels  der
* decrunch.library  entpacken.  Die  Bezeichnungen  der  DecrunchLib Offsets
* entsprechen mit hoher Wahrscheinlichkeit nicht den Originalen. Leider sind
* mir  die Include-Dateien dieser Library nicht bekannt, weshalb ich mir auf
* recht abenteuerlicher Weise (Reassemblierung einiger Objektdateien) Zugang
* zu  der Library verschaffen musste. Das Ergebnis hat sich aber gelohnt, da
* nun weit über 100! Packverfahren erkannt und entkomprimiert werden!
****************************************************************************

PicDcr		movea.l	my_FileBuf(a5),a0	;Test ob evtl. das
		cmpi.l	#'PP20',(a0)		;PP-Data Format?
		beq	PpDcr			;Ja! Eigene Decrunchroutine
		cmpi.l	#'XPKF',(a0)		;XPKF Format?
		beq	XpkDcr			;Ja
		move.l	my_DcrBase(a5),d0	;DcrunchLib geöffnet?
		bne.s	.1			;Ja!
		lea	DcrLib(pc),a1		;DecrunchLib öffnen
		EXE	OpenLibrary
		move.l	d0,my_DcrBase(a5)
		beq.s	.5			;Hat nicht geklappt!
.1		DCR	dcrAllocTagItem		;Info-Struktur einrichten
		movea.l	d0,a3
		move.l	my_FileBuf(a5),dcr_PackedBuf(a3)
		move.l	my_FileLen(a5),dcr_PackedLen(a3)
		movea.l	a3,a0
		LIB	dcrInitTagItem
		tst.l	d0
		beq.s	.4			;Packverfahren unbekannt
		bsr	PrtDcr
		movea.l	a3,a0
		LIB	dcrDecrunch
		tst.l	d0
		beq.s	.4			;Entpackung unmöglich!
.2		movea.l	my_FileBuf(a5),a1
		move.l	my_FileLen(a5),d0
		move.l	dcr_UnPackedBuf(a3),my_FileBuf(a5)
		move.l	dcr_UnPackedLen(a3),my_FileLen(a5)
		EXE	FreeMem			;Alten Buffer freigeben
.3		movea.l	a3,a0
		DCR	dcrFreeTagItem		;Struct Info freigeben
		bra	Ok			;Flag immer = Kein Fehler!
.4		bsr.s	.3
.5		bsr	PrtVError
		bra	Error			;Fehler!

;---------------------------------------------------------------------------
;Falls  das  Bild im PP-Data Format vorliegt, wird diese Routine aufgerufen.
;Da ich  fast ausschließlich mit dem PowerPacker 3.0b meine Daten packe, muß
;nur im Sonderfall die decrunch.library geöffnet werden, somit braucht diese
;nicht immer verfügbar sein (Platzersparnis).
;
;A0 <= Zeiger auf PP20 Daten
;---------------------------------------------------------------------------
PpDcr		move.l	my_FileLen(a5),d0
		move.l	-4(a0,d0.l),d0
		lsr.l	#8,d0
		moveq	#MEMF_PUBLIC,d1
		move.l	d0,my_PackLen(a5)
		EXE	AllocMem
		move.l	d0,my_PackBuf(a5)
		ble	Error
.1		bsr	PrtDcr
		movea.l	my_FileBuf(a5),a0
		movea.l	my_PackBuf(a5),a1
		move.l	my_FileLen(a5),d0
		bsr.s	PpStart
		movea.l	my_FileBuf(a5),a1
		move.l	my_FileLen(a5),d0
		move.l	my_PackBuf(a5),my_FileBuf(a5)
		move.l	my_PackLen(a5),my_FileLen(a5)
		LIB	FreeMem
		bra	Ok
PpStart		lea	4(a0),a3
		adda.l	d0,a0
		movea.l a1,a2
		moveq	#1,d5
		moveq	#3,d6
		moveq	#7,d7
		move.l	-(a0),d1
		tst.b	d1
		beq.s	.1
		bsr.s	Pp2
		subq.b	#1,d1
		lsr.l	d1,d5
.1		lsr.l	#8,d1
		adda.l	d1,a2
Pp1		bsr.s	Pp2
		bcs.s	Pp5
		moveq	#0,d2
.1		moveq	#1,d0
		bsr.s	Pp4
		add.w	d1,d2
		cmp.w	d6,d1
		beq.s	.1
.2		moveq	#7,d0
		bsr.s	Pp4
		move.b	d1,-(a2)
		dbra	d2,.2
		cmpa.l	a2,a1
		bcs.s	Pp5
		rts
Pp2		lsr.l	#1,d5
		beq.s	.1
		rts
.1		move.l	-(a0),d5
		roxr.l	#1,d5
		rts
Pp3		subq.w	#1,d0
Pp4		moveq	#0,d1
.1		lsr.l	#1,d5
		beq.s	.3
.2		roxl.l	#1,d1
		dbra	d0,.1
		rts
.3		move.l	-(a0),d5
		roxr.l	#1,d5
		bra.s	.2
Pp5		moveq	#1,d0
		bsr.s	Pp4
		moveq	#0,d0
		move.b	(a3,d1.w),d0
		move.w	d1,d2
		cmp.w	d6,d2
		bne.s	.3
		bsr.s	Pp2
		bcs.s	.1
		moveq	#7,d0
.1		bsr.s	Pp3
		move.w	d1,d3
.2		moveq	#2,d0
		bsr.s	Pp4
		add.w	d1,d2
		cmp.w	d7,d1
		beq.s	.2
		bra.s	.4
.3		bsr.s	Pp3
		move.w	d1,d3
.4		addq.w	#1,d2
.5		move.b	(a2,d3.w),-(a2)
		dbra	d2,.5
		cmpa.l	a2,a1
		bcs.s	Pp1
		rts

;---------------------------------------------------------------------------
;Da das Packprojekt der XPK-(Sub)Libraries weitreichend verwendet wird,  und
;die  'decrunch.library'  leider dieses nicht unterstützt, habe ich folgende
;XpkUnpack-Routine integriert.  Somit ist VPic kompatibler zu einer Vielzahl
;an Packalgorithmen.
;---------------------------------------------------------------------------
XpkDcr		move.l	my_XpkBase(a5),d0
		bne.s	.0
		lea	XpkLib(pc),a1
		EXE	OpenLibrary
		move.l	d0,my_XpkBase(a5)
		beq	.2
.0		movea.l	my_FileBuf(a5),a0
		move.l	12(a0),d0
		moveq	#MEMF_PUBLIC,d1
		move.l	d0,my_PackLen(a5)
		EXE	AllocMem
		move.l	d0,my_PackBuf(a5)
		ble.s	.2
		bsr	PrtDcr
		lea	XpkTagItem(pc),a0
		move.l	my_FileBuf(a5),4(a0)
		move.l	my_PackBuf(a5),12(a0)
		move.l	my_FileLen(a5),20(a0)
		move.l	my_PackLen(a5),28(a0)
		addi.l	#XPK_MARGIN,28(a0)
		XPK	XpkUnpack
		tst.l	d0
		bne.s	.1
		movea.l	my_FileBuf(a5),a1
		move.l	my_FileLen(a5),d0
		move.l	my_PackBuf(a5),my_FileBuf(a5)
		move.l	my_PackLen(a5),my_FileLen(a5)
		EXE	FreeMem
		bra	Ok
.1		movea.l	my_PackBuf(a5),a1
		move.l	my_PackLen(a5),d0
		EXE	FreeMem
.2		bsr.s	PrtVError
		bra	Error			;Fehler!

XpkTagItem	dc.l	XPK_InBuf,0		;SAdr
		dc.l	XPK_OutBuf,0		;DAdr
		dc.l	XPK_InLen,0		;SLen
		dc.l	XPK_OutBufLen,0		;DLen
		dc.l	XPK_Password,0		;Password
		dc.l	XPK_GetError,0		;Errorstring
		dc.l	XPK_PassThru,-1		;Packed data
		dc.l	XPK_ShortError		;Only error
		dc.l	TAG_DONE		;TagItemEnd

****************************************************************************
* Allgemeine Request-/Textausgabe
****************************************************************************

PrtVError	lea	TxRtVError(pc),a0
		bra.s	Rt_Error

PrtSError	lea	TxRtSError(pc),a0

Rt_Error	lea	my_FmtData(a5),a1
		move.l	my_FileName(a5),(a1)
		bsr	Rt_Fmt
		lea	my_DataBuf(a5),a4
		move.l	a0,8(a4)
		lea	TxRtError(pc),a0
		move.l	a0,(a4)
		lea	TxRtOK(pc),a0
		move.l	a0,4(a4)
		bsr	Rt_Request
		bra.s	PrtCLine

PrtDcr		bsr.s	PrtCLine
		lea	my_FmtData(a5),a0
		move.l	my_FileName(a5),(a0)
		lea	TxDecr(pc),a0
		bra.s	Fmt

PrtView		bsr.s	PrtCLine
		lea	my_FmtData(a5),a0
		move.l	my_FileName(a5),(a0)
		lea	TxView(pc),a0
		bra.s	Fmt

PrtLLine	lea	TxLLine(pc),a0
		bra.s	Fmt

PrtULine	lea	TxUFeed(pc),a2
		bsr.s	Prt

PrtCLine	lea	TxCFeed(pc),a2

Prt		tst.b	my_FromCLI(a5)		;Nur von CLI/Shell aus
		beq	Ok
		movem.l	a0-a6/d0-d7,-(sp)
		move.l	my_OutPut(a5),d1
		move.l	a2,d2
.0		tst.b	(a2)+
		bne.s	.0
		move.l	a2,d3
		sub.l	d2,d3
		DOS	Write
		movem.l	(sp)+,a0-a6/d0-d7
		rts

Fmt		tst.b	my_FromCLI(a5)
		beq	Ok
		movem.l	a0-a6/d0-d7,-(sp)
		lea	my_FmtData(a5),a1
		lea	.0(pc),a2
		lea	my_FmtChData(a5),a3
		EXE	RawDoFmt
		lea	my_FmtChData(a5),a2
		bsr.s	Prt
		movem.l	(sp)+,a0-a6/d0-d7
		rts
.0		move.b	d0,(a3)+
		rts

Rt_Fmt		movem.l	a1-a6/d0-d7,-(sp)
		lea	my_FmtData(a5),a1
		lea	.0(pc),a2
		lea	my_FmtChData(a5),a3
		EXE	RawDoFmt
		lea	my_FmtChData(a5),a0
		movem.l	(sp)+,a1-a6/d0-d7
		rts
.0		move.b	d0,(a3)+
		rts

****************************************************************************
* Das  DirEntryCount-Verfahren soll eine Erleichterung für eine vereinfachte
* Parameterübergabe darstellen. Die Idee basiert darauf das die Eintragungen
* eines Pfades immer gleich über die DOS Funktion Examine ausgelesen werden.
* Dieses macht sich das DirEntryCount-Verfahren  zu nutze indem  einfach die
* Kennung  #  gefolgt  von  der  Nummer des  Eintrages als Ersatz für  einen
* Dateinamen übergeben werden kann, über diese Angabe wird der zu der Nummer
* gehörende Dateiname ermittelt und eingesetzt.
****************************************************************************

;Beispiel: VPic DF3:Pics/#7
;Ergebnis: VPic DF3:Pics/Name der zu zeigenden Grafik

dec_init	movem.l	a0-a6/d0-d7,-(sp)

		movea.l	my_FileName(a5),a0	;A0 = #DirEntryCount
		lea	my_CountFib(a5),a1	;A1 = Buffer[260]

		movea.l	a0,a3
		movea.l	a1,a4

dec_searchid	cmpi.b	#'#',(a0)		;ID_DirEntryCount (#)
		beq.s	dec_foundid
		tst.b	(a0)+
		bne.s	dec_searchid
		bra.s	dec_end

dec_foundid	movea.l	a0,a2			;A2 = # Position für Fehler

		clr.b	(a0)+			;Für DosLock

		moveq	#0,d0			;Ziffer
		moveq	#0,d7			;DirEntryCount

dec_convcount	move.b	(a0)+,d0		;String in Count.w Zahl
		subi.b	#'0',d0
		bmi.s	dec_lock
		mulu	#10,d7
		ext.w	d0
		add.w	d0,d7
		bra.s	dec_convcount

dec_lock	move.l	a3,d1			;Pfad ohne DirEntryCount
		moveq.l	#ACCESS_READ,d2
		DOS	Lock
		move.l	d0,d6
		ble.s	dec_error

		move.l	d6,d1			;Lock
		move.l	a4,d2			;FileInfoBlock
		LIB	Examine
		tst.l	d0
		beq.s	dec_error

dec_excount	move.l	d6,d1			;Lock
		move.l	a4,d2			;FileInfoBlock
		LIB	ExNext
		tst.l	d0
		beq.s	dec_error
		subq.w	#1,d7
		bgt.s	dec_excount		;Bis DirEntryCount

		lea	fib_FileName(a4),a0
		lea	fib_EntryType(a4),a1
dec_movename	move.b	(a0)+,(a1)+
		bne.s	dec_movename

		movea.l	a4,a1			;FileInfoBlock
dec_path	move.b	(a3)+,(a1)+		;Pfad installieren
		bne.s	dec_path
		subq.l	#1,a1

		lea	fib_EntryType(a4),a0	;Zwischenpuffer für Datei
dec_name	move.b	(a0)+,(a1)+		;Datei installieren
		bne.s	dec_name

		move.l	a4,my_FileName(a5)	;Init. Pfad+Datei

dec_unlock	move.l	d6,d1
		ble.s	dec_end
		DOS	UnLock

dec_end		movem.l	(sp)+,a0-a6/d0-d7
		rts

dec_error	move.b	#'#',(a2)		;ID_DirEntryCount
		move.l	a2,my_FileName(a5)	;Angabe zurücksetzen
		bra.s	dec_unlock

****************************************************************************
* Fehler/Ok-Flags, Tastatur-Code, Warten
****************************************************************************

Error		moveq	#-1,d0			;Fehler!
		rts

Ok		moveq	#0,d0			;Alles geklappt!
		rts

CKey		moveq.l	#0,d1
		btst	#6,$BFE001
		bne.s	.0
		move.b	#$FF,my_KeyCode(a5)
		rts
.0		move.b	$BFEC01,d1
		eori.w	#$FF,d1
		ror.b	#1,d1
		move.b	d1,my_KeyCode(a5)
		cmpi.b	#RAW_ESC,d1		;Globaler ESC-Test
		rts

Wait		movem.l	a6/d0,-(sp)		;D1 = Wartezyklen 1/50
		DOS	Delay
		movem.l	(sp)+,a6/d0
		rts

****************************************************************************
* Usage & Keylist
****************************************************************************

Rt_Usage	lea	my_DataBuf(a5),a4
		lea	TxRtUsage(pc),a0
		move.l	a0,(a4)
		lea	TxRtOKKEYS(pc),a0
		move.l	a0,4(a4)
		lea	TxUsage(pc),a0
		move.l	a0,8(a4)
		bsr.s	Rt_Request
		tst.l	my_RtBut(a5)
		beq.s	Ok
.0		lea	my_DataBuf(a5),a4
		lea	TxRtKeys(pc),a0
		move.l	a0,(a4)
		lea	TxRtOKUSAGE(pc),a0
		move.l	a0,4(a4)
		lea	TxKeyList(pc),a0
		move.l	a0,8(a4)
		bsr.s	Rt_Request
		tst.l	my_RtBut(a5)
		bne.s	Rt_Usage
		bra	Ok

****************************************************************************
* ReqTools Request / Filerequest
****************************************************************************

;In =	0(a4)		- Fenstertitel
;	4(a4)		- Schalterbezeichnung(en)
;	8(a4)		- Textzeilen
;Out =	my_RtBut(a5)	- Schalternummer

Rt_Request	clr.l	my_RtBut(a5)
		bsr	Rt_OpenLib
		bne	Error
		suba.l	a0,a0
		REQ	rtAllocRequestA
		tst.l	d0
		ble	Error
		move.l	d0,my_RtInfoReq(a5)
		movea.l	d0,a3
		move.l	#1,(a3)
		move.w	#0,4(a3)
		move.w	#0,6(a3)
		move.l	(a4),12(a3)		;Fenstertitel
		move.l	#0,16(a3)
		suba.l	a0,a0
		movea.l	8(a4),a1		;Textzeilen
		movea.l	4(a4),a2		;Schalterbezeichnung(en)
		suba.l	a4,a4
		LIB	rtEZRequestA
		move.l	d0,my_RtBut(a5)		;Schalternummer
		movea.l	my_RtInfoReq(a5),a1
		LAB	rtFreeRequest

Rt_Input	clr.l	my_RtBut(a5)
		bsr	Rt_OpenLib
		bne	Ok

Rt_FileReq	tst.l	my_RtFileReq(a5)
		bne.s	.0
		suba.l	a0,a0
		moveq.l	#0,d0
		REQ	rtAllocRequestA
		tst.l	d0
		ble	Error
		move.l	d0,my_RtFileReq(a5)
.0		suba.l	a0,a0
		movea.l	my_RtFileReq(a5),a1
		move.l	#1,(a1)
		move.w	#0,4(a1)
		move.w	#0,6(a1)
		move.l	#0,8(a1)
		lea	my_DataBuf(a5),a2
		REQ	rtFileRequestA
		move.l	d0,my_RtBut(a5)
		beq	Ok
		lea	my_InputBuf(a5),a0
		move.l	a0,my_FileName(a5)
		move.l	my_RtFileReq(a5),a1
		lea	my_DataBuf(a5),a2
		movea.l	16(a1),a1
.1		move.b	(a1)+,(a0)+
		bne.s	.1
		suba.l	#1,a0
		cmpi.b	#':',-1(a0)
		beq.s	.2
		move.b	#'/',(a0)+
.2		move.b	(a2)+,(a0)+
		bne.s	.2
		bra	Ok

Rt_OpenLib	move.l	my_ReqBase(a5),d0
		bne.s	.0
		lea	ReqLib(pc),a1
		EXE	OpenLibrary
		move.l	d0,my_ReqBase(a5)
		ble.s	.1
.0		bra	Ok
.1		lea	.2(pc),a2
		bsr	Prt
		bra	Error
.2		dc.b	$A,$B,$9B,"33mError",$9B,"0m: Need reqtools.library!",10,0

****************************************************************************
* Datenbereich
****************************************************************************

TxUsage		dc.b	'Usage: VPic [file|list|path|#DEC] [0|1] [*|?]',10,10
		dc.b	' file - View a single picture',10
		dc.b	' list - View pics defined in a list',10
		dc.b	' path - View all pics avail in path',10
		dc.b	' #DEC - View pic named by DirEntryCount',10,10
		dc.b	' [0]  - View picture in actual CLI-Wind',10
		dc.b	' [1]  - View pic and set color in CLI-Wind',10,10
		dc.b	' [*]  - View next actual screen',10,10
		dc.b	'VPic V2.00 FD © 2002 by Peace of Testaware',0
		even
TxKeyList	dc.b	'[F1] ............ Info of pic  [N1] ........Set OS1.3 color',10
		dc.b	'[F2] ............ Save as IFF  [N2] ........Set OS2.0 color',10
		dc.b	'[F3] ........... Negative pic  [1-8] .......... Save as VBM',10
		dc.b	'[F4] ........ Pic to CLI-Wind  [HELP] ... Usage and keylist',10
		dc.b	'[F5] .. Pic/color to CLI-Wind  [RETURN] .. View next screen',10
		dc.b	'[F6] .............. Red shade  [RALT] ........ Multitasking',10
		dc.b	'[F7] ............ Green shade  [LALT] ... Stop multitasking',10
		dc.b	'[F8] ............. Blue shade  [SPACE] .......... Close pic',10
		dc.b	'[F9] ............. Grey shade  [LMB] ............ Close pic',10
		dc.b	'[F10] ......... Default color  [ESC] ............ Abort all',0
		even

TxRtLoadPIC	dc.b	'Load a picture',0
TxRtSaveIFF	dc.b	'Save as IFF',0
TxRtSaveVBM	dc.b	'Save as VBM',0
TxRtPicInfo	dc.b	'Info of picture',0
TxRtColorTab	dc.b	'Colortable [$RGB]',0
TxRtUsage	dc.b	'Usage of VPic',0
TxRtKeys	dc.b	'Keylist of VPic',0
TxRtError	dc.b	'Error',0
TxRtVError	dc.b	'Can`t view %s',0
TxRtSError	dc.b	'Can`t save %s',0
TxRtOK		dc.b	' Ok ',0
TxRtOKKEYS	dc.b	'Keys| Ok ',0
TxRtOKCOLS	dc.b	'Colors| Ok ',0
TxRtOKINFO	dc.b	'Info| Ok ',0
TxRtOKUSAGE	dc.b	'Usage| Ok ',0
		even

TxFORM		dc.b	'FORM'
		dc.l	0
TxILBM		dc.b	'ILBM'
TxBMHD		dc.b	'BMHD'
		dc.l	ibm_SIZEOF
		ds.b	ibm_SIZEOF
TxANNO		dc.b	'ANNO'
		dc.l	34
		dc.b	'VPic Release 2.00 © by Testaware',0,0
TxCAMG		dc.b	'CAMG'
		dc.l	4
		dc.l	0
TxCMAP		dc.b	'CMAP'
		dc.l	0
TxFormL		equ	*-TxFORM
TxBODY		dc.b	'BODY'
		dc.l	0

TxInfo		dc.b	'Name  :%s',10
		dc.b	'Width :%d',10
		dc.b	'Height:%d',10
		dc.b	'Depth :%d',10
		dc.b	'Colors:%ld',10
		dc.b	'Mode  :$%x',10
		dc.b	'Typ   :%s',10
		dc.b	'Size  :%ld'
TxCopy		dc.b	10
		dc.b	'(c)   :%s'
TxAuth		dc.b	10
		dc.b	'Auth  :%s'
TxAnno		dc.b	10
		dc.b	'Anno  :%s',0
		even

TxColMap	dc.b	'C%02d:$%03x ',0
		even

TxTyp		dc.b	'IFF Raw BitMap ',0
		dc.b	'IFF Compressed ',0
		dc.b	'IFF ACBM BitMap',0
		dc.b	'AMOS DataPack  ',0
		dc.b	'AMOS ScreenPack',0
		dc.b	'VPic BitMap    ',0
		dc.b	'WorkBench Info ',0
		dc.b	'Actual Screen  ',0

TxView		dc.b	$9B,'33mView',$9B,'0m: %s',0
TxDecr		dc.b	$9B,'33mDecrunch',$9B,'0m: %s',0
TxUFeed		dc.b	$B,0
TxCFeed		dc.b	$9B,$4D,$A,$B,0
TxLLine		dc.b	$C,$9B,'32',$74,$9B,'%d',$48,0
		even

DosLib		DOSNAME
IntLib		INTNAME
GfxLib		GRAFNAME
XpkLib		XPKNAME
DcrLib		DCRNAME
ReqLib		dc.b	'reqtools.library',0
		even

		END