>EXTERN "DH1:IMAGE.BMP"	,$50000

*************************************************
*DDT's DELTA-SHADE-PACKER Image Compressor v1.0	*
*	 For hard-shaded (or b&w) images	*
*						*
* Coder: DDT					*
* Date : 09/01/1992				*
*************************************************

;Palette must be sorted as a continuous shade.
;This version supports only a 16 colors palette.
;In this demo source the image must be 640x512.
;Press right mouse button to quit.

BUFFER=$300000		;StartAddress for DSP-file


jmp	s

org	$40000
load	$40000
s:
	move.l	#"HBT!",$0
	move.l	#$ffffffff,d0
	move.l	#SuperCode,$14
	or.l	#$44445421,d0
	and.l	#0,d0
	sne	d0
	divu	d0,d0
	rts

SuperCode:
	move.l	$6c,OldIRQ_6c+2		;Get $6c IRQ {
	move.l	#NewIRQ,$6c		;}.

	move.l	$68,OldIRQ_68+2		;Get $68 IRQ {
	move.l	#MyHandl,$68		;}.

	move.l	#Pointer,d0
	move.w	d0,Spr0Pnts+6
	swap	d0
	move.w	d0,Spr0Pnts+2

	move.l	$4.w,a6			;Take the execbase address,
	lea	gfxname,a1		;open the GFXlibrary {
	jsr	-408(a6)		;}.
	move.l	d0,gfxbase		;Save the GFXbase pointer,
	move.l	d0,a0			;move the GFXbase in a0,
	move.l	50(a0),oldclist		;save oldclist addr,
	move.l	#newclist,50(a0)	;replace with newclist addr.

MakeMeFeelGood:
	clr.l	d0
	clr.l	d1
	clr.l	d2
	clr.l	d3
	clr.l	d4
	clr.l	d5
	clr.l	d6
	clr.l	d7
	move.l	d0,a0
	move.l	d0,a1
	move.l	d0,a2
	move.l	d0,a3
	move.l	d0,a4
	move.l	d0,a5
	move.l	d0,a6

	bsr	PACK
	lea	$50000,a0
	move.w	#$a000,d0
CLS:	clr.l	(a0)+
	dbf	d0,CLS
	bsr	DEPACK
	bra.L	ScanMouse

********************************************
;	MAIN PROGRAM
;Delta-Shade-Packer start

PACK:
	lea	$50000,a0		;BitMap start		plane0
	lea	$5a000,a1		;BitMap start		plane1
	lea	$64000,a2		;BitMap start		plane2
	lea	$6e000,a3		;BitMap start		plane3
	moveq	#7,d0			;BitMap current bit	plane0

	lea	BUFFER,a6		;Packed start

	move.l	#"DSP1",(a6)+		;DSP1 format
	move.w	#640,(a6)+		;Picture Width
	move.w	#512,(a6)+		;Picture Height
	move.w	#4,(a6)+		;Number of planes
	move.w	#$000,(a6)+		;Color palette {
	move.w	#$111,(a6)+
	move.w	#$222,(a6)+
	move.w	#$333,(a6)+
	move.w	#$444,(a6)+
	move.w	#$555,(a6)+
	move.w	#$666,(a6)+
	move.w	#$777,(a6)+
	move.w	#$888,(a6)+
	move.w	#$999,(a6)+
	move.w	#$aaa,(a6)+
	move.w	#$bbb,(a6)+
	move.w	#$ccc,(a6)+
	move.w	#$ddd,(a6)+
	move.w	#$eee,(a6)+
	move.w	#$fff,(a6)+		;}.

	clr.b	(a6)			;Delete first DataByte
	moveq	#7,d6			;Packed current bit

	moveq	#-1,d2			;Previous color number
					;Start with -1: must be init.

PACKLOOP:
btst	#10,$dff016
bne.s	Qua
	rts
Qua:	moveq	#0,d1			;Color number (=gray level)
	btst	d0,(a0)			;Find color number {
	beq.s	Nope0
	bset	#0,d1
Nope0:	btst	d0,(a1)
	beq.s	Nope1
	bset	#1,d1
Nope1:	btst	d0,(a2)
	beq.s	Nope2
	bset	#2,d1
Nope2:	btst	d0,(a3)
	beq.s	Nope3
	bset	#3,d1			;}.
Nope3:

	move.w	d2,d4
	sub.w	d1,d4			;Find color difference
	beq.s	Equal			;Color is Equal...
	cmp.w	#-1,d4
	beq.L	Inc1			;Color is Inc1...
	cmp.w	#1,d4
	beq.L	Dec1			;Color is Dec1...


;That's for outrange color:

move.w	#$0000,$dff180
	bset	d6,(a6)			;Set New_Color header (%11)
	subq.w	#1,d6			
	bpl.s	NoNxt0
	addq.w	#1,a6
	clr.b	(a6)
	moveq	#7,d6
NoNxt0:	bset	d6,(a6)
	subq.w	#1,d6
	bpl.s	NoNxt1
	addq.w	#1,a6
	clr.b	(a6)
	moveq	#7,d6
NoNxt1:

	btst	#3,d1			;Put New_Color number (%bbbb)
	beq.s	NoS3
	bset	d6,(a6)
NoS3:	subq.w	#1,d6
	bpl.s	NoNxt2
	addq.w	#1,a6
	clr.b	(a6)
	moveq	#7,d6
NoNxt2:
	btst	#2,d1
	beq.s	NoS2
	bset	d6,(a6)
NoS2:	subq.w	#1,d6
	bpl.s	NoNxt3
	addq.w	#1,a6
	clr.b	(a6)
	moveq	#7,d6
NoNxt3:
	btst	#1,d1
	beq.s	NoS1
	bset	d6,(a6)
NoS1:	subq.w	#1,d6
	bpl.s	NoNxt4
	addq.w	#1,a6
	clr.b	(a6)
	moveq	#7,d6
NoNxt4:
	btst	#0,d1
	beq.s	NoS0
	bset	d6,(a6)
NoS0:	subq.w	#1,d6
	bpl.s	NoNxt5
	addq.w	#1,a6
	clr.b	(a6)
	moveq	#7,d6
NoNxt5:
	move.w	d1,d2
	bra.s	PIXELDONE

;That's for Equal color:

Equal:
move.w	#$0ff0,$dff180
	subq.w	#1,d6			;Set Equal_Color (%00)
	bpl.s	NoNxt6
	addq.w	#1,a6
	clr.b	(a6)
	moveq	#7,d6
NoNxt6:	subq.w	#1,d6
	bpl.s	NoNxt7
	addq.w	#1,a6
	clr.b	(a6)
	moveq	#7,d6
NoNxt7:
	bra.s	PIXELDONE


;That's for Inc1 color:

Inc1:
move.w	#$00f0,$dff180
	subq.w	#1,d6			;Set Inc1_Color (%01)
	bpl.s	NoNxt8
	addq.w	#1,a6
	clr.b	(a6)
	moveq	#7,d6
NoNxt8:	bset	d6,(a6)
	subq.w	#1,d6
	bpl.s	NoNxt9
	addq.w	#1,a6
	clr.b	(a6)
	moveq	#7,d6
NoNxt9:
	addq.w	#1,d2
	bra.s	PIXELDONE


;That's for Dec1 color:

Dec1:
move.w	#$0f00,$dff180
	bset	d6,(a6)			;Set Dec_Color (%10)
	subq.w	#1,d6			
	bpl.s	NoNxtA
	addq.w	#1,a6
	clr.b	(a6)
	moveq	#7,d6
NoNxtA:	subq.w	#1,d6
	bpl.s	NoNxtB
	addq.w	#1,a6
	clr.b	(a6)
	moveq	#7,d6
NoNxtB:
	subq.w	#1,d2


PIXELDONE:
;Examine next Pixel:
bchg	#1,$bfe001
	subq.w	#1,d0
	bpl.s	NoNxtByte
	addq.w	#1,a0
	addq.w	#1,a1
	addq.w	#1,a2
	addq.w	#1,a3
	moveq	#7,d0
NoNxtByte:
	cmp.l	#$5a000,a0
	bne.L	PACKLOOP		;Loop Packer...

	sub.l	#BUFFER,a6		;End: find lenght of PackedFile
	move.l	a6,PackLenght
	rts

PackLenght:	dc.l	0


*************************************************
;DSP Depacker start:

DEPACK:
	lea	BUFFER,a6		;Packed start
	move.w	4(a6),d0		;Get Image width
	move.w	6(a6),d1		;Get image height
	lsr.w	#3,d0			;Get bytes per row
	mulu	d0,d1			;Get plane size

	lea	$50000,a0		;BitMap start		plane0
	move.l	a0,a1
	add.l	d1,a1			;BitMap start		plane1
	move.l	a1,a4			;Start of plane1 in a4 for endc
	move.l	a1,a2
	add.l	d1,a2			;BitMap start		plane2
	move.l	a2,a3
	add.l	d1,a3			;BitMap start		plane3
	clr.b	(a0)
	clr.b	(a1)
	clr.b	(a2)
	clr.b	(a3)

	moveq	#7,d0			;BitMap current bit	plane0

	move.w	8(a6),d2		;Get number of colors
	moveq	#0,d1
	bset	d2,d1
	lsl.w	#1,d1
	add.w	#10,d1
	add.w	d1,a6			;Find address of Packed Data
	moveq	#7,d6			;Bit counter for Packed Data

	moveq	#-1,d2			;Previous color

DEPACKLOOP:
bchg	#1,$bfe001
btst	#10,$dff016
bne.s	Quo
	rts
Quo:	moveq	#0,d3			;Get New_Color header in d3 {
	btst	d6,(a6)
	beq.s	NoD1
	bset	#1,d3
NoD1:	subq.w	#1,d6
	bpl.s	NoOut0
	addq.w	#1,a6
	moveq	#7,d6
NoOut0:	btst	d6,(a6)
	beq.s	NoD0
	bset	#0,d3
NoD0:	subq.w	#1,d6
	bpl.s	NoOut1
	addq.w	#1,a6
	moveq	#7,d6			;}.
NoOut1:

	cmp.b	#%00,d3			;Test for packed shade type
	bne.s	NoEq
	move.w	d2,d1
	bra.s	SetPixel
NoEq:	cmp.b	#%01,d3
	bne.s	NoInc1
	move.w	d2,d1
	addq.w	#1,d1
	bra.s	SetPixel
NoInc1:	cmp.b	#%10,d3
	bne.s	NoPack
	move.w	d2,d1
	subq.w	#1,d1
	bra.s	SetPixel

NoPack:	moveq	#0,d1			;Not a packed color!
	btst	d6,(a6)			;Get color number {
	beq.s	NoD2
	bset	#3,d1
NoD2:	subq.w	#1,d6
	bpl.s	NoOut2
	addq.w	#1,a6
	moveq	#7,d6
NoOut2:	btst	d6,(a6)
	beq.s	NoD3
	bset	#2,d1
NoD3:	subq.w	#1,d6
	bpl.s	NoOut3
	addq.w	#1,a6
	moveq	#7,d6
NoOut3:	btst	d6,(a6)
	beq.s	NoD4
	bset	#1,d1
NoD4:	subq.w	#1,d6
	bpl.s	NoOut4
	addq.w	#1,a6
	moveq	#7,d6
NoOut4:	btst	d6,(a6)
	beq.s	NoD5
	bset	#0,d1
NoD5:	subq.w	#1,d6
	bpl.s	NoOut5
	addq.w	#1,a6
	moveq	#7,d6
NoOut5:					;}.
	move.w	d1,d2			;d1=color of pixel
;	bra.s	SetPixel



SetPixel:
	btst	#0,d1
	beq.s	NS0
	bset	d0,(a0)
NS0:	btst	#1,d1
	beq.s	NS1
	bset	d0,(a1)
NS1:	btst	#2,d1
	beq.s	NS2
	bset	d0,(a2)
NS2:	btst	#3,d1
	beq.s	NS3
	bset	d0,(a3)
NS3:
	move.w	d1,d2		;Set previous color
	subq.w	#1,d0
	bpl.L	DepackLoop
	moveq	#7,d0
	addq.w	#1,a0
	addq.w	#1,a1
	addq.w	#1,a2
	addq.w	#1,a3
	cmp.l	a0,a4
	beq.s	EndDep
	clr.b	(a0)
	clr.b	(a1)
	clr.b	(a2)
	clr.b	(a3)
	bra.L	DepackLoop

EndDep:	rts



***********  SCANMOUSE  ***********		(Coder: DDT)
; This is the Main PanelHandler loop.

ScanMouse:
	btst	#10,$dff016
	bne.s	ScanMouse

***********************************

exit:	move.l	gfxbase,a0		;Take the GFXbase,
	move.l	oldclist,50(a0)   	;Reset old copperlist addr.
	move.l	$04.w,a6		;Take the execbase address,
	move.l	gfxbase,a1		;close the GFXlibrary {
	jsr	-414(a6)  		;}.
	move.l	OldIRQ_6c+2,$6c		;Reset $6c IRQ
	move.l	OldIRQ_68+2,$68		;Reset $68 IRQ
	rte				;Return.


***************************************
***	VBLANK IRQ HANDLER   ($6c)  ***
***************************************

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

	move.w	$dff004,d0
	btst	#15,d0
	bne.s	Nojk
	lea	Pointers,a0
	move.w	#$0050,6(a0)
	move.w	#$a050,14(a0)
	move.w	#$4050,22(a0)
	move.w	#$e050,30(a0)
	bra.s	MouseDriver
Nojk:	lea	Pointers,a0
	move.w	#$0000,6(a0)
	move.w	#$a000,14(a0)
	move.w	#$4000,22(a0)
	move.w	#$e000,30(a0)

MouseDriver:
;...
ExIRQ:	movem.l	(sp)+,d0-d7/a0-a6
OldIRQ_6c:
	jmp	$00000000

Lo:	dc.w	$0
Hi:	dc.w	$0
SprX:	dc.w	$a0
SprY:	dc.w	$70
X:	dc.w	0
Y:	dc.w	0


***************************************
***	CIA IRQ HANDLER      ($68)  ***
***************************************
MyHandl:
	move.b	$bfec01,KCod
	clr.b	$bfec01
OldIRQ_68:
	jmp	$00000000

KCod:	dc.l	0

even
newclist:
dc.w	$008e,$2c81,$0090,$2cc1,$0092,$003c,$0094,$00d0
dc.w	$0102,$0000,$0104,$0000,$0108,$0050,$010a,$0050
dc.w	$0100,$c204 ;4 BitPlanes
Pointers:
dc.w    $00e0,$0005,$00e2,$0050,$00e4,$0005,$00e6,$a050
dc.w	$00e8,$0006,$00ea,$4050,$00ec,$0006,$00ee,$e050

Spr0Pnts:
dc.w	$0120,$0000,$0122,$0000

; Set color registers:

col1:	dc.w	$0180,$0000	;Sorted as a shade!
	dc.w	$0182,$0111
	dc.w	$0184,$0222
	dc.w	$0186,$0333
	dc.w	$0188,$0444
	dc.w	$018a,$0555
	dc.w	$018c,$0666
	dc.w	$018e,$0777
	dc.w	$0190,$0888
	dc.w	$0192,$0999
	dc.w	$0194,$0aaa
	dc.w	$0196,$0bbb
	dc.w	$0198,$0ccc
	dc.w	$019a,$0ddd
	dc.w	$019c,$0eee
	dc.w	$019e,$0fff


even
oldclist:	dc.l	0
gfxbase:	dc.l	0
gfxname:	dc.b	"graphics.library",0
even
Pointer:	blk.w	40