*****************************************************************************
* 3D-Star routine - Using the 'exsys.library' startup routines...
* --------------------------------------------------------------------------
* This entire 3d-demo routine when using the 'exsys.library' routines takes
* up only 908 bytes of diskspace UNCOMPRESSED!!!! 
*****************************************************************************
PlaneHeight	= 255
PlaneWidth	= 40
PlaneLen	= PlaneHeight*PlaneWidth
PL		= PlaneLen
PlaneBLTSIZE	= 3*PlaneHeight*64+(PlaneWidth/2)
MaxTiefe	= $2000
StarCount	= 335
X		= 160
Y		= 160
Z		= 256
ClipX		= 319
ClipY		= 254
movespeed	= 5

		section	example,code_c

*-------------- Were including the 'exsys.library' startup call here.

		include	'work:exsyslib/include/hardware/exsys_takeover.s'

*-------------- end of startup routine calls...

		bsr.b	InitStars
		lea	NCList(pc),a0
		bsr.b	newcopper
		
Main:		cmpi.b	#255,$dff006
		bne.s	Main
		bsr.w	movestars
		bsr.w	ChangePlanes
		btst	#6,$bfe001
		bne.s	Main
		rts

newcopper:	lea 	$dff000,a6		;a6=custom hardware
		move.w	#$7fff,$96(a6)		;no dma
		move.l	a0,$80(a6)		;install new copperlist ptr
		clr.w	$88(a6)			;strobe copper
		move.w	#$83c0,$96(a6)		;enable copper dma
		rts

InitStars	lea	StarDatas,a0
		move.w	#$1fff,d3
		move.w	#StarCount-1,d7
.Loop:		bsr.b	GetWord			;X Word
		add.w	#X,d2
		and.w	d3,d2
		sub.w	#X,d2
		move.w	d2,(a0)+
		bsr.b	GetWord			;Y Word
		add.w	#Y,d2
		and.w	d3,d2
		sub.w	#Y,d2
		move.w	d2,(a0)+
		bsr.b	GetWord			;Z Word
		add.w	#Z,d2
		and.w	d3,d2
		sub.w	#Z,d2
		move.w	d2,(a0)+
		dbf	d7,.Loop
		lea	YTab,a0		; calc table
		moveq	#0,d0
		move.w	#PlaneHeight-1,d7
.Looop:		move.w	d0,(a0)+
		add.w	#PlaneWidth,d0
		dbra	d7,.Looop
		lea	PerspTab,a1		;build division table
		move.w	#Z,d0
		add.w	d0,a1
		add.w	d0,a1
		move.w	#Z,d2
		mulu	#$7fff,d2
.Loop2:		move.l	d2,d1
		divu	d0,d1
		move.w	d1,(a1)+
		addq.w	#1,d0
		cmp.w	#MaxTiefe,d0
		bne.s	.Loop2
		rts

GetWord:	bsr.s	GetByte
		move.b	d0,d2
		lsl.w	#8,d2
		bsr.s	GetByte
		move.b	d0,d2
		rts

GetByte:	move.b	$dff007,d0
		move.b	$bfd800,d1
		eor.b	d1,d0
		moveq	#0,d1
		move.b	d0,d1
		ror.b	#1,d1
.loop:		dbf	d1,.loop
		rts

ChangePlanes:	lea	Plane(pc),a0
		movem.l	(a0),d0-d2
		exg	d0,d1
		exg	d1,d2
		movem.l	d0-d2,(a0)
		lea	PlanePtrs(pc),a0
		move.w	d0,6(a0)
		swap	d0
		move.w	d0,2(a0)
		swap	d0
		add.l	#PlaneLen,d0
		move.w	d0,6+8(a0)
		swap	d0
		move.w	d0,2+8(a0)
		swap	d0
		add.l	#PlaneLen,d0
		move.w	d0,6+16(a0)
		swap	d0
		move.w	d0,2+16(a0)
		swap	d0
		rts

movestars	lea	$dff000,a6
BlitWait	btst	#6,$02(a6)		; wait till blitter free
		bne.s	BlitWait
		move.l	DelPlane(pc),$54(a6)
		clr.w	$66(a6)
		move.l	#$01000000,$40(a6)
		move.w	#PlaneBLTSIZE,$58(a6)	; clear screen memory
		move.w	#StarCount-1,d7		;64 Stars
		lea	StarDatas,a0		;Ptr StarDatas
		lea	PerspTab,a1		;Projection Table
		movem.w	XAdd(pc),a4-a6		;Put coordinate adds in regs
		move.w	#ClipX,a3		;Clipping constante
		move.w	#ClipY,d5
		move.w	#$1fff,d3
		move.w	#$1000,d4		;middle value
		add.w	d4,a4			;+x add
		add.w	d4,a5			;+y add
.Loop:		movem.w	(a0),d0-d2		;Get coordinate
		add.w	a4,d0			;add middle and de/increase x
		and.w	d3,d0			;check overflow
		sub.w	d4,d0			;sub middle
		add.w	a5,d1			;add middle and de/increase y
		and.w	d3,d1			;check overflow
		sub.w	d4,d1			;sub middle
		add.w	a6,d2			;de/increase z
		and.w	d3,d2			;check overflow
		movem.w	d0-d2,(a0)		;save coords
		addq.w	#6,a0			;(there is no movem.w d0,(a0)+)
.SetStar:	cmp.w	#Z,d2			;z<d2?
		blt.s	.Next			;-> Next star
		add.w	d2,d2			;Z*2
		move.w	(a1,d2.w),d6		;Projektionswert holen
		muls	d6,d0			;projection
		swap	d0			;
		add.w	#X,d0			;X middle of screen (160)
		cmp.w	a3,d0			;a3=ClipX (Clipping)
		bhi.s	.Next			;Don't plot
		muls	d6,d1			;projection
		swap	d1
		add.w	#Y,d1			;Y middle of screen (128)
		cmp.w	d5,d1			;a4=ClipY
		bhi.s	.Next			;Don't plot
		move.l	WorkPlane(pc),a2	;plot pixel
		move.w	d0,d6
		lsr.w	#3,d6
		add.w	d6,a2
		add.w	d1,d1
		move.l	a5,-(sp)
		lea	YTab,a5
		add.w	(a5,d1.w),a2
		move.l	(sp)+,a5
		not.w	d0
		rol.w	#6,d2			;get color
		and.w	#$e,d2
		move.w	.JT(pc,d2.w),d2
		jmp	.JT(pc,d2.w)

.JT:		dc.w	.r6-.JT,.r6-.JT,.r5-.JT,.r4-.JT
		dc.w	.r3-.JT,.r2-.JT,.r1-.JT,.r0-.JT

.r0:		bset	d0,(a2)			;plot routines...
.next:		dbf	d7,.Loop
		rts
.r1:		bset	d0,PL(a2)
		dbf	d7,.Loop
		rts
.r2:		bset	d0,(a2)
		bset	d0,PL(a2)
		dbf	d7,.Loop
		rts
.r3:		bset	d0,PL*2(a2)
		dbf	d7,.Loop
		rts
.r4:		bset	d0,(a2)
		bset	d0,PL*2(a2)
		dbf	d7,.Loop
		rts
.r5:		bset	d0,PL(a2)
		bset	d0,PL*2(a2)
		dbf	d7,.Loop
		rts
.r6:		bset	d0,(a2)
		bset	d0,PL(a2)
		bset	d0,PL*2(a2)
		dbf	d7,.Loop
		rts

NCList:		dc.l	$01200000,$01220000,$01240000,$01260000
		dc.l	$01280000,$012a0000,$012c0000,$012e0000
		dc.l	$01300000,$01320000,$01340000,$01360000
		dc.l	$01380000,$013a0000,$013c0000,$013e0000
		dc.l	$008e2c81,$00902bc1,$00920038,$009400d0
		dc.l	$01020000,$01040000,$01080000,$010a0000
		dc.l	$01000200
PlanePtrs:	dc.l	$00e00000,$00e20000,$00e40000,$00e60000
		dc.l	$00e80000,$00ea0000
		dc.l	$01003200
		dc.l	$01800000,$01820333,$01840555,$01860777
		dc.l	$01880999,$018a0bbb,$018c0ddd,$018e0fff
		dc.l	-2

XAdd:		dc.w	0
YAdd:		dc.w	0
ZAdd:		dc.w	100
Plane:		dc.l	Plane1
WorkPlane:	dc.l	Plane2
DelPlane:	dc.l	Plane3

		section	b,bss_c
Plane1:		ds.b	PlaneLen*3
Plane2:		ds.b	PlaneLen*3
Plane3:		ds.b	PlaneLen*3
PerspTab:	ds.w	MaxTiefe
StarDatas:	ds.w	StarCount*3
YTab:		ds.w	PlaneHeight