*************** 3D Starfields..

PlaneHeight	= 255
PlaneWidth	= 40
PlaneLen	= PlaneHeight*PlaneWidth
PL		= PlaneLen
PlaneBLTSIZE	= 3*PlaneHeight*64+(PlaneWidth/2)
MaxTiefe	= $2000
StarCount	= 335
X		= 160
Y		= 128
Z		= 256
ClipX		= 319
ClipY		= 254
JoySpeed	= 5

		section	chippy,code_c
		
WAITBLITT:	MACRO
		btst	#6,$02(a6)
.\@:		btst	#6,$02(a6)
		bne.s	.\@
		ENDM

		incdir	'scene1:coding/asm/demos/exsyslib/'
		include	'include/hardware/exsys_takeover.s' ;1st codeline!

		bsr	RandomStars
		bsr.s	CalcTab
		bsr.w	MakePerspTab

		lea	(_Custom).l,a6		; custom base address in a6
		move.w	#$7fff,intena(a6)	; turn off intena
		move.l  #Copperlist,cop1lch(a6)	; install custom copperlist
		move.w	d0,copjmp1(a6)		; clear second copperlist
		move.w	#$c020,intena(a6)	; return INTENA:
		move.w  #$87c0,dmacon(a6)	; return DMA:Cop/Blit/Sprite

***************************************************
*** Main Loop					***
***************************************************

Main:		cmp.b	#255,$dff006
		bne.s	Main

		bsr	ClearPlane
		bsr	JoyControl
		bsr.w	New3DStars
		lea	$dff000,a6
		bsr	ChangePlanes

		btst	#6,$bfe001
		bne.s	Main
		rts

***************************************************
*** Build Y Table				***
***************************************************

CalcTab:	lea	YTab(pc),a0
		moveq	#0,d0
		move.w	#PlaneHeight-1,d7
.Loop:		move.w	d0,(a0)+
		add.w	#PlaneWidth,d0
		dbra	d7,.Loop
		rts

***************************************************
*** Build Division Table			***
***************************************************

MakePerspTab:	lea	PerspTab,a1
		move.w	#Z,d0
		add.w	d0,a1
		add.w	d0,a1
		move.w	#Z,d2
		mulu	#$7fff,d2
.Loop:		move.l	d2,d1
		divu	d0,d1
		move.w	d1,(a1)+
		addq.w	#1,d0
		cmp.w	#MaxTiefe,d0
		bne.s	.Loop
		rts

***************************************************
*** Random Stars				***
***************************************************

RandomStars:	lea	StarDatas,a0
		move.w	#$1fff,d3
		move.w	#StarCount-1,d7

.Loop:		bsr.s	GetWord			;X Word
		add.w	#X,d2
		and.w	d3,d2
		sub.w	#X,d2
		move.w	d2,(a0)+
		bsr.s	GetWord			;Y Word
		add.w	#Y,d2
		and.w	d3,d2
		sub.w	#Y,d2
		move.w	d2,(a0)+
		bsr.s	GetWord			;Z Word
		add.w	#Z,d2
		and.w	d3,d2
		sub.w	#Z,d2
		move.w	d2,(a0)+
		dbf	d7,.Loop
		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

***************************************************
*** 3D Star Routine				***
***************************************************

New3DStars:	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)+)

; >--- Projection, vlipping und plot
;/

.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

;It's very important to do the following commands in this order. It's very
;stupid of you do it like this:
;			muls	d6,d0
;			muls	d6,d1
;			swap	d0
;			swap	d1
;			etc...
;Ok, the source looks better but there is one BIG disadvantage!!! If e.g.
;the x value isn't in the screen you don't have the plot this pixel. But
;if the pixel musn't be plot it is really stupid to check/calculate the
;y value!!! Understood??? The following routine is much better! It first
;checks if the x value is within the screen. If it is, the y value will be
;calculated. If not, the y value won't be calculated (We can't save the
;unneccessary 'muls d6,d1' in this case!!!

		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
		add.w	YTab(pc,d1.w),a2
		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

XAdd:		dc.w	0
YAdd:		dc.w	0
ZAdd:		dc.w	-100

YTab:		ds.w	PlaneHeight

***************************************************
*** Joystick Control				***
***************************************************

JoyControl:	lea	XAdd(pc),a0
		lea	ZAdd(pc),a1
		tst.b	$bfe001			;Y or Z?
		bpl.s	.Pressed		;Z-> Pressed

		lea	YAdd(pc),a1		;otherwise Y

.Pressed:	move.w	$0c(a6),d0
		btst	#1,d0
		beq.s	.TstLinks
		subq.w	#JoySpeed,(a0)
		bra.s	.DoY
.TstLinks:	btst	#9,d0
		beq.s	.DoY
		addq.w	#JoySpeed,(a0)

.DoY:		move.w	d0,d1
		lsr.w	#1,d1
		eor.w	d0,d1
		btst	#0,d1
		beq.s	.TstVorne
		addq.w	#JoySpeed,(a1)
		bra.s	.Exit
.TstVorne:	btst	#8,d1
		beq.s	.Exit
		subq.w	#JoySpeed,(a1)
.Exit:		rts

***************************************************
*** clear DelPlane				***
***************************************************

ClearPlane:	WAITBLITT

		move.l	DelPlane(pc),$54(a6)
		clr.w	$66(a6)
		move.l	#$01000000,$40(a6)
		move.w	#PlaneBLTSIZE,$58(a6)
		rts

***************************************************
*** Tripple Buffering				***
***************************************************

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

Plane:		dc.l	Plane1
WorkPlane:	dc.l	Plane2
DelPlane:	dc.l	Plane3

***************************************************
*** Datas					***
***************************************************

* Try Germany/0+$4498a7c!!! (Ask for Karsten!)

Copperlist:	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,$01060000,$01fc0000

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

		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

Level3Vector	equ $6c
SysCop1		equ $26
_ciaa:		equ $bfe001
_ciab:		equ $bfd000
left		equ 6

_custom:	equ $dff000
bltddat:	equ $000
dmaconr:	equ $002
vposr:		equ $004
vhposr:		equ $006
dskdatr:	equ $008
joy0dat:	equ $00a
joy1dat:	equ $00c
clxdat:		equ $00e
adkconr:	equ $010
pot0dat:	equ $012
pot1dat:	equ $014
potgor:		equ $016
serdatr:	equ $018
dskbytr:	equ $01a
intenar:	equ $01c
intreqr:	equ $01e
dskpth:		equ $020
dskptl:		equ $022
dsklen:		equ $024
dskdat:		equ $026
refptr:		equ $028
vposw:		equ $02a
vhposw:		equ $02c
copcon:		equ $02e
serdat:		equ $030
serper:		equ $032
potgo:		equ $034
joytest:	equ $036
strequ:		equ $038
strvbl:		equ $03a
strhor:		equ $03c
strlong:	equ $03e
bltcon0:	equ $040
bltcon1:	equ $042
bltafwm:	equ $044
bltalwm:	equ $046
bltcpth:	equ $048
bltcptl:	equ $04a
bltbpth:	equ $04c
bltbptl:	equ $04e
bltapth:	equ $050
bltaptl:	equ $052
bltdpth:	equ $054
bltdptl:	equ $056
bltsize:	equ $058
bltcmod:	equ $060
bltbmod:	equ $062
bltamod:	equ $064
bltdmod:	equ $066
bltcdat:	equ $070
bltbdat:	equ $072
bltadat:	equ $074
dsksync:	equ $07e
cop1lch:	equ $080
cop1lcl:	equ $082
cop2lch:	equ $084
cop2lcl:	equ $086
copjmp1:	equ $088
copjmp2:	equ $08a
copins:		equ $08c
diwstrt:	equ $08e
diwstop:	equ $090
ddfstrt:	equ $092
ddfstop:	equ $094
dmacon:		equ $096
clxcon:		equ $098
intena:		equ $09a
intreq:		equ $09c
adkcon:		equ $09e
aud0pth:	equ $0a0
aud0ptl:	equ $0a2
aud0len:	equ $0a4
aud0per:	equ $0a6
aud0vol:	equ $0a8
aud0dat:	equ $0aa
aud1pth:	equ $0b0
aud1ptl:	equ $0b2
aud1len:	equ $0b4
aud1per:	equ $0b6
aud1vol:	equ $0b8
aud1dat:	equ $0ba
aud2pth:	equ $0c0
aud2ptl:	equ $0c2
aud2len:	equ $0c4
aud2per:	equ $0c6
aud2vol:	equ $0c8
aud2dat:	equ $0ca
aud3pth:	equ $0d0
aud3ptl:	equ $0d2
aud3len:	equ $0d4
aud3per:	equ $0d6
aud3vol:	equ $0d8
aud3dat:	equ $0da
bpl1pth:	equ $0e0
bpl1ptl:	equ $0e2
bpl2pth:	equ $0e4
bpl2ptl:	equ $0e6
bpl3pth:	equ $0e8
bpl3ptl:	equ $0ea
bpl4pth:	equ $0ec
bpl4ptl:	equ $0ee
bpl5pth:	equ $0f0
bpl5ptl:	equ $0f2
bpl6pth:	equ $0f4
bpl6ptl:	equ $0f6
bplcon0:	equ $100
bplcon1:	equ $102
bplcon2:	equ $104
bpl1mod:	equ $108
bpl2mod:	equ $10a
bpl1dat:	equ $110
bpl2dat:	equ $112
bpl3dat:	equ $114
bpl4dat:	equ $116
bpl5dat:	equ $118
bpl6dat:	equ $11a
spr0pth:	equ $120
spr0ptl:	equ $122
spr1pth:	equ $124
spr1ptl:	equ $126
spr2pth:	equ $128
spr2ptl:	equ $12a
spr3pth:	equ $12c
spr3ptl:	equ $12e
spr4pth:	equ $130
spr4ptl:	equ $132
spr5pth:	equ $134
spr5ptl:	equ $136
spr6pth:	equ $138
spr6ptl:	equ $13a
spr7pth:	equ $13c
spr7ptl:	equ $13e
spr0pos:	equ $140
spr0ctl:	equ $142
spr0data:	equ $144
spr0datb:	equ $146
spr1pos:	equ $148
spr1ctl:	equ $14a
spr1data:	equ $14c
spr1datb:	equ $14e
spr2pos:	equ $150
spr2ctl:	equ $152
spr2data:	equ $154
spr2datb:	equ $156
spr3pos:	equ $158
spr3ctl:	equ $15a
spr3data:	equ $15c
spr3datb:	equ $15e
spr4pos:	equ $160
spr4ctl:	equ $162
spr4data:	equ $164
spr4datb:	equ $166
spr5pos:	equ $168
spr5ctl:	equ $16a
spr5data:	equ $16c
spr5datb:	equ $16e
spr6pos:	equ $170
spr6ctl:	equ $172
spr6data:	equ $174
spr6datb:	equ $176
spr7pos:	equ $178
spr7ctl:	equ $17a
spr7data:	equ $17c
spr7datb:	equ $17e
color00:	equ $180
color01:	equ $182
color02:	equ $184
color03:	equ $186
color04:	equ $188
color05:	equ $18a
color06:	equ $18c
color07:	equ $18e
color08:	equ $190
color09:	equ $192
color10:	equ $194
color11:	equ $196
color12:	equ $198
color13:	equ $19a
color14:	equ $19c
color15:	equ $19e
color16:	equ $1a0
color17:	equ $1a2
color18:	equ $1a4
color19:	equ $1a6
color20:	equ $1a8
color21:	equ $1aa
color22:	equ $1ac
color23:	equ $1ae
color24:	equ $1b0
color25:	equ $1b2
color26:	equ $1b4
color27:	equ $1b6
color28:	equ $1b8
color29:	equ $1ba
color30:	equ $1bc
color31:	equ $1be
open:		equ -30
close:		equ -36
read:		equ -42
write:		equ -48
input:		equ -54
output:		equ -60
seek:		equ -66
deletefile:	equ -72
rename:		equ -78
lock:		equ -84
unlock:		equ -90
duplock:	equ -96
examine:	equ -102
exnext:		equ -108
info:		equ -114
createdir:	equ -120
currentdir:	equ -126
ioErr:		equ -132
CreateProc:	equ -138
exit:		equ -144
loadseg:	equ -150
unloadseg:	equ -156
getpacket:	equ -162
queupacket:	equ -168
deviceproc:	equ -174
setcomment:	equ -180
setprotection:	equ -186
datestamp:	equ -192
delay:		equ -198
waitforchar:	equ -204
parentdir:	equ -210
IsInteractive:	equ -216
Execute:	equ -222

AbsExecBase:	equ 4
forbid		equ -132
permit		equ -138
allocmem:	equ -198
freemem:	equ -210
getmsg:		equ -372
replymsg:	equ -378
waitport:	equ -384
closelibrary:	equ -414
opendevice:	equ -444
closedevice:	equ -450
doio:		equ -456
oldopenlibrary	equ -408
openlibrary:	equ -552