************************************************************************
* 4-Bitplane-Zoom-Routine    (C) May 1991 by the WEAPONMASTER/CYTAX    *
* Release in I.C.E. Issue #5	                                       *
************************************************************************
* I programmed this routine after I saw Sanity's 'Elysium'-demo.       *
* It wasn't my original intention to publish this sourcecode, so I     *
* didn't comment the routines in the way as I would do, if the source- *
* code should be released. For this reason nearly all comments are in  *
* German, but I decided to publish it, because a lot of coders wanted  *
* a copy from me.  The important routines are partially optimised, but *
* not the routines for display-, start-initialization and main-loop.   *
* I didn't want to waste much time, so I used parts of my older        *
* productions for controlling the important routines.                  *
************************************************************************

* If you want to contact me for any reason write to the I.C.E. address
* but mark your sending, that the other Cytax-members will notice
* that they should give it to me.
* (e.g. add something like: 'to Weaponmaster' or 'to WPM.')

* For 'zooming' press left Mouse-Button, right MB for exit
* The sourcecode originally worked with 'Seka V3.2', Source Modified to work
* with ASM-One / Devpac (or compatibles)..

;Macro for blitter waiting..

waitblit	macro
\@wblit		btst	#14,(A5)
		bne.s	\@wblit
		endm

		section	chippy,code_c

start:	move.l 4.w,a6
	jsr -132(a6)			;Forbid (eigentlich nicht notwendig,
				;da IRQs später aus)
	lea grname,a1
	jsr -408(a6)
	move.l d0,graphicsbase
	beq error

	lea $dff002,a5
	move.w $1a(a5),intenaold
	move.w #$7fff,$98(a5)		;IRQs aus

	move.w #$03f0,$94(a5)
	move.w #$2c81,$8c(a5)
	move.w #$f5c1,$8e(a5)
	move.w #$38,$90(a5)
	move.w #$d0,$92(a5)
	move.w #$4200,$fe(a5)
	move.w #0,$100(a5)

	move.w #$2c07,d0
	move.w #$fffe,d1
	move.l #$01080078,d2
	move.l #$010a0078,d3
	move.w #$100,d4
	move.w #$f507,d5
	lea cpl_mod-6,a0

cop_init1:
	move.w d0,(a0)+
	move.w d1,(a0)+
	move.l d2,(a0)+
	move.l d3,(a0)+
	add.w  d4,d0
	cmp.w d5,d0
	blo.s cop_init1

	lea col1,a0
	lea $17e(a5),a1
	move.w #$f,d0
cop_init2:
	move.w (a0)+,(a1)+
	dbf d0,cop_init2

	move.l #cladr,$7e(a5)
	move.w #0,$86(a5)

	move.l #planes1,planeakt
	move.l #planes2,planeverd
	clr.w bildnr

	move.l planeakt,d0
	move.w d0,cladr+2
	swap d0
	move.w d0,cladr+6
	swap d0
	add.l #40,d0
	move.w d0,cladr+10
	swap d0
	move.w d0,cladr+14
	swap d0
	add.l #40,d0
	move.w d0,cladr+18
	swap d0
	move.w d0,cladr+22
	swap d0
	add.l #40,d0
	move.w d0,cladr+26
	swap d0
	move.w d0,cladr+30

	move.w #$87c0,$94(a5)

	bsr tabinit
	bsr hauptprogramm

	move.w #$03f0,$94(a5)

	move.w intenaold,d0
	bset #15,d0
	move.w d0,$98(a5)
	move.l graphicsbase,a1
	move.l 38(a1),$7e(a5)
	move.w #0,$86(a5)
	jsr -414(a6)
	move.w #$83f0,$94(a5)
error:
	jsr -138(a6)
	clr.l d0
	rts

intenaold: dc.w 0

hauptprogramm:
	clr.w bildnr

ranzoomen:
	btst #10,$14(a5)
	beq ende
	btst #6,$bfe001
	bne.s ranzoomen

	move.w bildnr,d0
	move.l planeakt,a0
	lea 160(a0),a0
	move.l planeverd,a1
	lea 160(a1),a1
	lea origpic,a4
	bsr vergroessern
	bsr umschalten
	addq.w #1,bildnr
	cmpi.w #160,bildnr
	blt.s ranzoomen

	subq.w #1,bildnr

	move.l #$30000,d0
verz:
	subq.l #1,d0
	bne.s verz

wegzoomen:
	btst #10,$14(a5)
	beq ende
	btst #6,$bfe001
	bne.s wegzoomen

	move.w bildnr,d0
	move.l planeakt,a0
	lea 160(a0),a0
	move.l planeverd,a1
	lea 160(a1),a1
	bsr verkleinern
	bsr umschalten
	subq.w #1,bildnr
	bpl.s wegzoomen
	bra hauptprogramm

ende:	rts

bildnr: dc.w 0

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

umschalten:
	move.l planeakt,d0
	move.l planeverd,d1
	exg d0,d1
	move.l d0,planeakt
	move.l d1,planeverd

waitrast:
	move.w 4(a5),d1
	and.w #$ff00,d1
	cmp.w #$f600,d1
	blo.s waitrast

	move.w d0,cladr+2
	swap d0
	move.w d0,cladr+6
	swap d0
	add.l #40,d0
	move.w d0,cladr+10
	swap d0
	move.w d0,cladr+14
	swap d0
	add.l #40,d0
	move.w d0,cladr+18
	swap d0
	move.w d0,cladr+22
	swap d0
	add.l #40,d0
	move.w d0,cladr+26
	swap d0
	move.w d0,cladr+30

	move.l #cpl_mod,d0
	waitblit
	move.l d0,$52(a5)		;DPT
	move.w #-40,$72(a5)		;ADAT
	move.w #10,$64(a5)		;DMOD
	move.l #$ffffffff,$42(a5)	;Masken
	move.l #$01f00000,$3E(a5)	;CON0
	move.w #$3241,$56(a5)		;SIZE

	move.w bildnr,d1
	add.w d1,d1
	add.w d1,d1
	lea	ModTabZeiger,a0
	move.l (a0,d1.w),a0

	move.w (a0)+,d1			;Offset
	move.w (a0)+,d2			;Anzahl = Blt-Height
	beq.s um_next

	lsl.w #6,d2
	addq.w #1,d2			;Bltsize

	ext.l d1
	add.l d0,d1			;Startadresse.

	waitblit
	move.l a0,$4e(a5)		;APT
	move.l d1,$52(a5)		;DPT
	move.w #$09f0,$3e(a5)		;CON0
	move.w #0,$62(a5)		;AMOD
	move.w d2,$56(a5)		;Size

um_next:
	waitblit

	move.l d0,$4e(a5)		;APT
	addq.l #4,d0
	move.l d0,$52(a5)		;DPT
	move.w #10,$62(a5)		;AMOD
	move.w #$09f0,$3E(a5)		;CON
	move.w #$3241,$56(a5)		;SIZE

	waitblit
	rts

**********************************************************************
* Startinitialisierungen der Zoom-Routine                            *
**********************************************************************

TabInit:
	lea ZeilenTab(PC),a0
	lea BitTab(PC),a1

	moveq #15,d0

ti_loop1:
 	lea WortTab(PC),a2
 	move.w (a1)+,d1
 	move.w #9,d2

ti_loop2:
  	move.w (a2)+,d3
	asl.w #4,d3
	add.w d1,d3
  	move.w d3,(a0)+
	dbf d2,ti_loop2
	dbf d0,ti_loop1

	lea ArbeitsTab(pc),a0
	move.w #159,d0
	move.w #2000,d1
ti_loop3:
 	move.w d1,(a0)+
	dbf d0,ti_loop3

	lea ZeilenTab(pc),a0
	lea Einftab(pc),a1
	lea ArbeitsTab(pc),a2
	clr.w d0

ti_loop4:
 	move.w (a0,d0.w),d1
 	moveq #-2,d2

ti_loop5:
	addq.w #2,d2
	cmp.w (a2,d2.w),d1
	bgt.s ti_loop5

 	lea 318(a2),a3
 	lea (a2,d2.w),a4

ti_loop6:
  	move.w -(a3),2(a3)
	cmpa.l a4,a3
	bhi.s ti_loop6

 	move.w d1,(a4)

	lsr.w #1,d2
	move.w d2,(a1)+
	addq.w #2,d0
	cmp.w #160*2,d0
	blo.s ti_loop4

	lea VielfachenTab,a2
	clr.w (a2)+

	move.w #120,d0
	move.w #160,d1
	move.w #200,d2

ti_loop10:
	move.w d0,(a2)+
	add.w d1,d0
	dbf d2,ti_loop10

;Modulotabelle aufbauen

	lea modulotab,a0
	lea ModTabZeiger,a1
	lea Vielfachentab,a2
	moveq #1,d7			;n = Breite /2

	move.l a0,(a1)+			;Offset auf Daten in ModTab für
	move.l #0,(a0)+			;Bildnr. 0 (nichts sichtbar)


ti_loop9:
	move.l a0,(a1)+			;Offset auf Daten in ModTab für
				;jeweilige Bildnr.
	moveq #0,d6			;Register für Coplistoffsets

	move.w d7,d0			;n
	move.w d7,d2
	mulu #$a000,d0
	move.l #$640000,d1
	sub.l d0,d1
	swap d1				;= erste Zeile, in der Modulos
				;aus Tab geschrieben werden
	add.w d1,d1
	add.w d1,d1			;4*
	add.w d1,d6			;+
	add.w d1,d1			;8*
	add.w d1,d6			;=12* (da 	move Mod1; Mod2; Wait =
				;(3 CopperBefehle)
	add.l d0,d0
	swap d0				;= 2n* 200/320 = Höhe

	move.l #$a000,d1
	divu d2,d1
	swap d1
	clr.w d1
	lsr.l #8,d1			;$a000/n * $100  als $10000er-Bruch

	moveq #0,d2
	moveq #0,d4

;in d0: Anzahl (eigentlich Anzahl-1 wegen Zeile 0) -> Schleifenvar.
;in d1: Zähler zum Aufaddieren
;d2: Aufaddierungsregister
;d3:
;d4: Jeweils letzte Zeile
;d6: Coplistoffset
;a0: ModTab
;a1: ModZeiger
;a2: VielfachenTab

	move.w d6,(a0)+			;Coplistoffset schreiben
	move.w d0,(a0)+			;Anzahl-1 schreiben
	addq.w #1,-2(a0)		;+1 = Anzahl (Bltsize-Höhe)

	bra.s ti_loop7

ti_loop8:
	add.l d1,d2			;Zähler aufaddieren
	swap d2				;= i-te Zeile
	move.w d2,d3			;darzustellende OrigZeile

	sub.w d4,d3			;- letzte OrigZeile = Zeilendifferenz
	add.w d3,d3			;*2 = VielfachenOffset

;	move.w  d3,(a0)+
	move.w (a2,d3.w),(a0)+		;Mod aus VfTab nach ModTab schreiben
	move.w d2,d4
	swap d2
ti_loop7:
	dbf d0, ti_loop8

	move.w #201,d3			;Von letzter Zeile (d4) auf OrgZeile 201
	sub.w d4,d3			;Zeilendifferenz
	add.w d3,d3
	move.w (a2,d3.w),(a0)+
;	move.w  d3,(a0)+
	addq.w #1,d7
	cmp.w #160,d7
	bls.s ti_loop9
	rts

****************************************************************************
verkleinern:
****************************************************************************

;A0 Quellpuffer
;A1 Zielpuffer
;Bildnr. in d0

;	lea $dff002,a5

	add.w d0,d0
	lea EinfTab(pc),a2
	move.w #$9f,d6
	sub.w (a2,d0.w),d6

	move.l a0,a2			;Pufferadr. kopieren
	move.l a1,a3

	move.w d6,d7
	not.w d7
	and.w #$f,d7			;Bitnr. links in   d7
	lsr.w #4,d6			;Breite-1 in W. in d6
	move.w d6,d5
	add.w d5,d5			;Breite-2 in B. in d5

*** LINKER TEIL

	moveq #38,d0
	sub.w d5,d0
	move.w d6,d1
	add.w #$c801,d1

	waitblit
	move.l #$fffffffe,$42(a5)	;FWM,LWM
	movem.l a0/A1,$4E(a5)		;APT,DPT
	move.w d0,$62(a5)		;AMOD
	move.w d0,$64(a5)		;DMOD
	move.l #$19f00000,$3e(a5)	;CON0,CON1
	move.w d1,$56(a5)		;SIZE

*** LINKER TEIL RECHTES WORT

	adda.w d5,a0
	adda.w d5,a1
	clr.w d4
	bset d7,d4
	subq.w #1,d4
;beq nächste Blitteroperation
	moveq #38,d2
	waitblit
	movem.l a0/a1,$4E(a5)		;APT,DPT
	move.l a1,$4a(a5)		;BPT
	move.w d2,$60(a5)		;BMOD
	move.w d2,$62(a5)		;AMOD
	move.w d2,$64(a5)		;DMOD
	move.w #$ffff,$44(a5)		;LWM
	move.w d4,$6e(a5)		;CDAT
	move.w #$0de4,$3e(a5)		;CON0
	move.w #$c801,$56(a5)		;SIZE

*** MITTE

	moveq #18,d2
	sub.w d5,d2			;Breite Mitte in W.
	beq.s vk_nextBlit		;falls 0, nächste Operation
	moveq #40,d3
	sub.w d2,d3
	sub.w d2,d3
	add.w #$c800,d2
	addq.w #2,a0
	addq.w #2,a1

	waitblit
	movem.l a0/a1,$4e(a5)		;APT,DPT
	move.w d3,$62(a5)		;AMOD
	move.w d3,$64(a5)		;DMOD
	move.w #$09f0,$3e(a5)		;CON0
	move.w d2,$56(a5)		;SIZE

*** RECHTER TEIL

vk_nextblit:
	lea $7d00-2(a2),a2
	lea $7d00-2(a3),a3
	waitblit
	movem.l a2/a3,$4E(a5)		;APT,DPT
	move.w #$7fff,$44(a5)		;LWM
	move.w d0,$62(a5)		;AMOD
	move.w d0,$64(a5)		;DMOD
	move.l #$19f00002,$3e(a5)	;CON0,CON1
	move.w d1,$56(a5)		;SIZE

*** RECHTER TEIL LINKES WORT

	eori.w #$f,d7
	addq.w #1,d7
	clr.w d4
	bset d7,d4
	;subq.w #1,d7
	subq.w #1,d4
	not.w d4
	;beq Ende (==> RTS)

	moveq #38,d2
	suba.w d5,a2
	suba.w d5,a3

	waitblit
	movem.l a2/a3,$4E(a5)		;APT,DPT
	move.l a3,$4a(a5)		;BPT
	move.w d2,$60(a5)		;BMOD
	move.w d2,$62(a5)		;AMOD
	move.w d2,$64(a5)		;DMOD
	move.w #$ffff,$44(a5)		;LWM
	move.w d4,$6e(a5)		;CDAT
	move.w #$0DE4,$3e(a5)		;CON0
	move.w #$c801,$56(a5)		;SIZE
	rts

****************************************************************************
vergroessern:
****************************************************************************

;A0 Quellpuffer
;A1 Zielpuffer
;Bildnr. in d0
;A4 Zeiger auf OriginalBild

	lea $dff002,a5

	lea einftab(pc),a2
	add.w d0,d0
	move.w d0,-(a7)                 ;Tabellenoffset auf Stack retten
	move.w #$9f,d6
	sub.w (a2,d0.w),d6

	move.l a0,a2			;Pufferadr. kopieren
	move.l a1,a3

	move.w d6,d7
	and.w #$f,d7			;Bitpos rechts in d7
	lsr.w #4,d6			;Breite-1 in W. d6
	move.w d6,d5
	add.w d5,d5			;Breite-2 in B. in d5

*** RECHTER TEIL

	lea 38(a0),a0
	lea 38(a1),a1
	suba.w d5,a0			;Startadr.	
	suba.w d5,a1

	moveq #38,d0
	sub.w d5,d0			;Modulo
	move.w d6,d1
	add.w #$c801,d1			;Size

	waitblit
	move.l #$ffffffff,$42(a5)       ;FWM,LWM
	movem.l a0/a1,$4e(a5)		;APT,DPT
	move.w d0,$62(a5)               ;AMOD
	move.w d0,$64(a5)		;DMOD
	move.l #$19f00000,$3e(a5)       ;CON0,CON1
	move.w d1,$56(a5)		;SIZE

*** RECHTER TEIL LINKES WORT

		lea $7d00-4(a2),a0
		lea $7d00-2(a3),a1		;Startadr.
		suba.w d5,a0
		suba.w d5,a1

		clr.w d4
		addq.w #1,d7
		bset d7,d4
		subq.w #1,d7
		subq.w #1,d4			;Maske
		not.w d4
		;beq next_Blit_OP

		moveq #38,d2			;Modulo

		waitblit

		move.l a1,$4a(a5)		;BPT
		move.l a1,$4e(a5)		;APT
		move.l a1,$52(a5)		;DPT
		move.w d2,$60(a5)		;BMOD
		move.w d2,$62(a5)		;AMOD
		move.w d2,$64(a5)		;DMOD
		move.w d4,$6e(a5)		;CDAT
		move.l #$1de40002,$3e(a5)       ;CON0,CON1
		move.w #$c801,$56(a5)		;SIZE

;next_Blit_O:P
		subq.w #2,a1

*** MITTE

		moveq #18,d2
		sub.w d5,d2                     ;Breite Mitte in W.
		beq.s vgr_nextblit		;falls 0, nächste Operation
		moveq #40,d3
		sub.w d2,d3
		sub.w d2,d3			;Modulo

		waitblit
		movem.l a0/a1,$4e(a5)		;APT,DPT
		move.w d3,$62(a5)		;AMOD
		move.w d3,$64(a5)               ;DMOD
		move.w d2,d3
		add.w #$c800,d2
		move.w #$09f0,$3e(a5)		;CON0
		move.w d2,$56(a5)		;SIZE
		add.w d3,d3
		suba.w d3,a0
		suba.w d3,a1

*** LINKER TEIL

vgr_nextblit:
		waitblit
		movem.l a0/a1,$4e(a5)		;APT,DPT
		move.w d0,$62(a5)		;AMOD
		move.w d0,$64(a5)		;DMOD
		move.w #$19f0,$3e(a5)		;CON0
		move.w d1,$56(a5)		;SIZE

*** LINKER TEIL RECHTES WORT

		lea (a3,d5.w),a1
		moveq #38,d2
		clr.w d4
		eori.w #$f,d7
		bset d7,d4
		subq.w #1,d4
		;beq nextOp

		waitblit
		move.l a1,$4a(a5)		;BPT
		move.l a1,$4e(a5)		;APT
		move.l a1,$52(a5)		;DPT
		move.w d2,$60(a5)		;BMOD
		move.w d2,$62(a5)		;AMOD
		move.w d2,$64(a5)		;DMOD
		move.w d4,$6e(a5)		;CDAT
		move.l #$1de40000,$3e(a5)	;CON0,CON1
		move.w #$c801,$56(a5)		;SIZE

;Daten, die jetzt noch benötigt werden:
;d5 (Breite-2) in Bytes
;a3 Zielpuffer
;a4 Zeiger auf OriginalBild
;d7 Bitnummer Einfügstelle links

		move.w (a7)+,d0			;Bildnr.

*** Zeile links einfügen

		lea ZeilenTab(pc),a2
		move.w (a2,d0.w),d6		;Origzeile Zeilentab
		move.w #$9f,d1
		sub.w d6,d1			;Origzeile $9f-Zeilentab
		move.w d1,d2
		not.w d2
		and.w #$f,d2			;Bitpos Origzeile links
		lsr.w #4,d1
		add.w d1,d1                     ;Offset in OrigBild in Bytes

		lea (a4,d1.w),a0		;Quelle OrigBild
		lea (a3,d5.w),a1		;Ziel A/D
		bsr einfuegen

*** Zeile rechts einfügen

		neg.w d1
		lea 38(a4,d1.w),a0
		neg.w d5
		lea 38(a3,d5.w),a1
		eor #$f,d7
		eor #$f,d2
		bsr einfuegen
		rts

einfuegen:	clr.w   d4
		bset d7,d4
		move.w d2,d3
		sub.w d7,d3
		bmi ef_desc

;ascending
		ror.w #4,d3			;Barrelshifter-Bits positionieren
		or.w  #$0de4,d3
		waitblit
		movem.l a0/a1,$4e(a5)		;APT,DPT
		move.l  a1,$4a(a5)		;BPT
		move.w  d3,$3e(a5)		;CON0
		move.w  #0,$40(a5)		;CON1
		move.w  d4,$6e(a5)              ;CDAT
		move.w  #$c801,$56(a5)		;SIZE
		rts

ef_desc:	neg.w d3
		ror.w #4,d3
		or.w #$0de4,d3

		lea 799*40(a0),a0
		lea 799*40(a1),a1
		waitblit
		movem.l a0/a1,$4e(a5)		;APT,DPT
		move.l  a1,$4a(a5)		;BPT
		move.w 	d3,$3e(a5)		;CON0
		move.w #2,$40(a5)		;CON1
		move.w d4,$6e(a5)		;CDAT
		move.w #$c801,$56(a5)		;SIZE
		rts

ZeilenTab:	dcb.w 160,0
EinfTab: 	dcb.w 160,0
ArbeitsTab:	dcb.w 160,0

WortTab:	dc.w 0,5,7,3,9,1,6,4,8,2
BitTab:		dc.w 8,12,4,14,2,10,6,15,0,3,13,5,11,9,7,1

grname:		dc.b "graphics.library",0,0
graphicsbase:	dc.l 0

cladr:		dc.w	$e2,0,$e0,0, $e6,0,$e4,0, $ea,0, $e8,0, $ee,0, $ec,0
		dc.w	0,0,0
cpl_mod:	dcb.b	6,0
		dcb.b	200*12
		dc.w	$1fc,0,$106,0
		dc.w	$ffff,$fffe

planeAkt:	dc.l planes1
planeVerd:	dc.l planes2

VielfachenTab:	dcb.w 202,0
ModTabZeiger:	dcb.l 161,0
ModuloTab:	dcb.b 33044 	;Format dc.w Coplistoffset,Anzahl,
                           	;            Wert1, Wert2, ...
planes1:	dcb.b 32320,0
planes2:	dcb.b 32320,0
origpic:	incbin	'src:phagexrips/bitmaps/transorb.raw'	;dcb.b 32000,0
col1:		dc.w	$000,$fff,$eee,$ddd,$ccc,$bbb,$aaa,$999
		dc.w	$888,$777,$666,$555,$444,$333,$222,$111