;*******************************************************************
;		    JOHAN SANNEBLAD PRESENTERAR:
;
;			   VEKTOR DEMO #1
;*******************************************************************
Execbase	equ	$4
Openlibrary	equ	-408
Closelibrary	equ	-414
Allocmem	equ	-198
Freemem		equ	-210
Forbid		equ	-132
Permit		equ	-138
Mem_in_chip	equ	$10002

	include	'SYS:Chip/CustomRegisters'
;-------------------------------------------------------------------
	movea.l	$4.w,a6
	move.l	Allocatesize,d0
	move.l	#Mem_in_chip,d1
	jsr	Allocmem(a6)
	tst.l	d0
	beq.w	Neej
	move.l	d0,Skarmen
	add.l	#Skarmsize,d0
	move.l	d0,Skarmbuffer
	add.l	#SkarmSize,d0
	move.l	d0,Linjebuffer
	add.l	#LinjeSize,d0
	move.l	d0,Copper

	jsr	Forbid(a6)

	move.w	$dff002,Olddma
	add.w	#$8000,Olddma

	move.w	#$01ff,$dff096

	move.l	Skarmen,d1	Initiera skarmen i coppern
	lea.l	Bitplan,a2
	addq	#2,a2
	moveq	#2,d2
loop2	swap	d1
	move.w	d1,(a2)
	addq	#4,a2
	swap	d1
	move.w	d1,(a2)
	addq	#4,a2
	add.l	#40,d1
	dbra	d2,loop2

	move.l	Execbase,a6
	lea.l	GrafNamn,a1
	jsr	Openlibrary(a6)
	move.l	d0,Grafbas
	move.l	d0,a6
	move.l	$26(a6),Oldcopper

	lea.l	Capper,a1
	movea.l	Copper,a2
	move.l	#Coppersize,d1
clopp	move.b	(a1)+,(a2)+
	dbra	d1,clopp

	move.l	Copper,$dff080
	clr.w	$dff088

	move.w	#$85c0,$dff096

	bsr.w	Rotera
	bsr.w	Polygonrita

	move.w	IntEnaR,Oldintena
	or.w	#$c000,OldIntEna

	move.w	#$7fff,IntEna	Alla interrupts av!
	move.l	$6c.w,OldInt
	move.l	#MainLoop,$6c.w
	move.w	#$7fff,IntReq
	move.w	#$c020,Intena

Musse	btst	#6,$bfe001
	bne.s	musse

	move.l	Oldcopper(pc),$dff080
	move.w	Olddma(pc),$dff096
	move.w	#$7fff,IntEna
	move.l	OldInt,$6c.w
	move.w	OldIntEna,IntEna

	movea.l	$4.w,a6
	move.l	Skarmen,a1
	move.l	Allocatesize,d0
	jsr	Freemem(a6)
	jsr	Permit(a6)
Neej	rts

;*******************************************************************
			Mainloop:
;*******************************************************************
	movem.l	d0-d7/a0-a6,-(sp)

	bsr.w	Skarmbuffercopy
	bsr.w	Rotera
 	bsr.w	Rensaskarmbuffer
 	bsr.w	Polygonrita

	sub.w	#4,Xvinkel	2 därför att det är
	and.w	#$1fe,Xvinkel	words listan bygger på!
	add.w	#2,Yvinkel
	and.w	#$1fe,Yvinkel
	add.w	#6,Zvinkel
	and.w	#$1fe,Zvinkel

	move.w	#$4020,IntReq
	movem.l	(sp)+,d0-d7/a0-a6
	rte
;-------------------------------------------------------------------
			Rensaskarmbuffer:
;-------------------------------------------------------------------
	tst.b	KopEj
	bne.s	RensEj
	move.l	Skarmbuffer,a0
	add.l	BliOff,a0

Cloop	btst	#6,dmaconr
	bne.s	Cloop

	move.w	#$100,bltcon0
	move.w	#2,bltcon1
	move.l	a0,bltdpth
	move.w	BliMod,bltamod
	move.w	BliMod,bltdmod
	move.w	BliSize,bltsize
RensEj	rts
;-------------------------------------------------------------------
			Skarmbuffercopy:
;-------------------------------------------------------------------
	tst.b	KopEj
	bne.s	KoppaEj
	move.l	Skarmbuffer,a0
	move.l	Skarmen,a1
	add.l	BliOff,a0
	add.l	BliOff,a1

Svamp	btst	#6,dmaconr
	bne.B	svamp
	move.l	a0,bltapth
	move.l	a1,bltdpth
	move.w	#$09f0,bltcon0
	move.w	#2,bltcon1
	move.w	BliMod,bltamod
	move.w	BliMod,bltdmod
	move.w	BliSize,bltsize		; Rensa x linjer
KoppaEj	rts
;-------------------------------------------------------------------
			Rotera:
;-------------------------------------------------------------------
	move.l	#Antalkoords-1,d7
	move.l	#Koords,a0
	move.l	#Roteradekoords,a2
	lea.l	Sinus+$40,a3

Vloop	move.w	(a0)+,d0	X koordinat
	move.w	(a0)+,d1	Y koordinat
	move.w	d0,d2
	move.w	d1,d3

	move.w	Zvinkel,d6

	muls	$40(a3,d6.w),d0		x1 = x*cos*a-y*sin*a
	muls	-$40(a3,d6.w),d1
	sub.l	d1,d0
	lsl.l	#1,d0
	swap	d0			x1 färdig

	muls	$40(a3,d6.w),d3		y1 = y*cos*a+x*sin*a
	muls	-$40(a3,d6.w),d2
	add.l	d3,d2
	lsl.l	#1,d2
	swap	d2			y1 färdig

	move.w	d2,d4

	move.w	(a0)+,d1		Z-koordinat
	move.w	d1,d3

	move.w	Xvinkel,d6

	muls	$40(a3,d6.w),d2		y2=y1*cos*X-z*sin*X
	muls	-$40(a3,d6.w),d1
	sub.l	d1,d2
	lsl.l	#1,d2
	swap	d2			y2 färdig

	muls	$40(a3,d6.w),d3		z1=z*cos*x+y1*sin*x
	muls	-$40(a3,d6.w),d4
	add.l	d4,d3
	lsl.l	#1,d3
	swap	d3			z1 färdig

	move.w	d0,d1
	move.w	d3,d4

	move.w	Yvinkel,d6

	muls	$40(a3,d6.w),d3		z2=z1*cos*y-x1*sin*y
	muls	-$40(a3,d6.w),d0
	sub.l	d0,d3
	lsl.l	#1,d3
	swap	d3			z2 färdig

	muls	-$40(a3,d6.w),d4
	muls	$40(a3,d6.w),d1
	add.l	d4,d1
	lsl.l	#1,d1
	swap	d1

;*********************************************
;*                PERSPEKTIV!                *
;*********************************************
	ext.l	d3		; ZKoord
	move.w	Djup,d0		; Förminskningsfaktor
	sub.w	d3,d0		; Faktor-ZKoord
	ext.l	d0		; ... i d0...
	lsl.l	#8,d0		; d0*256 pga att vi ej arbetar med decimaler
	move.w	ZObs,d4
	ext.l	d4

	sub.l	d3,d4		; ZObs-ZKoord
	bne.s	EjNoll
	
	moveq	#0,d1
	move.w	d1,(a2)+
	move.w	d1,(a2)+
	bra.s	Nulls

EjNoll	divs	d4,d0		; Faktor/ZObs=Perspektiv
	move.w	d0,d4
	move.w	d1,d5
	neg.w	d1		; -XKoord
	muls	d1,d4		; -XKoord*Perspektiv
	asr.l	#8,d4

	add.w	d4,d5		; XKoord-XKoordPerspektiv
	add.w	XOff,d5		; + XOffset
	move.w	d5,(a2)+	; X klar...

	move.w	d2,d5
	neg.w	d2		; -YKoord
	muls	d2,d0		; -YKoord*Perspektiv
	asr.l	#8,d0

	add.w	d0,d5		; YKoord-YKoordPerspektiv
	neg.w	d5
	add.w	YOff,d5		; + YOffset
	move.w	d5,(a2)+	; Y klar...

Nulls	dbra	d7,Vloop

	rts

;-------------------------------------------------------------------
			Polygonrita:
;-------------------------------------------------------------------
	move.l	#Roteradekoords,a3
	move.l	#Ytor,a6
	move.w	#AntalYtor,YtCount
	st	KopEj

Ritloop	move.l	(a6)+,d7	; Antal koordinater
	sub.l	#1,d7
	move.l	(a6)+,a4	; Adress till Yta(x)
	move.l	(a6)+,Batplan	; Vilka bitplan skall fyllas?
	move.w	(a4),d4		; Koordinat 1
	move.w	2(a4),d5	; Koordinat 2
	move.w	(a3,d4.w),d0	; x1
	sub.w	(a3,d5.w),d0	; dx1=x1-x2
	move.w	2(a3,d4.w),d1	; y1
	sub.w	2(a3,d5.w),d1	; dy1=y1-y2

	move.w	2(a4),d4	; Koordinat 2
	move.w	4(a4),d5	; Koordinat 3
	move.w	(a3,d4.w),d2	; x1
	sub.w	(a3,d5.w),d2	; dx2=x1-x2
	move.w	2(a3,d4.w),d3	; y1
	sub.w	2(a3,d5.w),d3	; dy2=y1-y2

	muls	d3,d0		; dx1*dy2
	muls	d2,d1		; dx2*dy1

	cmp.w	d0,d1
	blt.w	Ritlop2
	
	bra	ritaej2

	cmp.l	#2,Batplan
	bne.s	Vrak
	move.l	#0,Batplan
	bra.w	Ritlop2
Vrak	add.l	#4,Batplan

Ritlop2	clr.b	KopEj
	move.w	(a4)+,d5	; X1Y1-offset
	move.w	(a3,d5.w),d0	; x1
	move.w	2(a3,d5.w),d1	; y1
	move.w	(a4),d5		; X2Y2-offset
	move.w	(a3,d5.w),d2	; x2
	move.w	2(a3,d5.w),d3	; y2

	cmp.w	d1,d3		; Ar y²>y¹
	bge.s	KNer		; Ar konstanten nedåt?

	exg	d0,d2		; y² SKALL vara större än y¹
	exg	d1,d3

KNer	move.w	PyttX,d4	; D4=minX
	move.w	StorX,d6	; D6=maxX
	cmp.w	d6,d0		; Ar x¹>maxX
	ble.s	MinX
	move.w	d0,d6		; d0=maxX
MinX	cmp.w	d4,d0		; Ar x¹<minX
	bge.s	MinY
	move.w	d0,d4		; d0=minX
MinY	cmp.w	PyttY,d1	; Ar y¹>minY
	bge.s	MaxX
	move.w	d1,PyttY	; y²=minY
MaxX	cmp.w	d6,d2		; Ar x2>maxX
	ble.s	MinX2
	move.w	d2,d6		; x²=maxX
MinX2	cmp.w	d4,d2		; Ar x²<minX
	bge.s	MaxY
	move.w	d2,d4		; x²=minX
MaxY	cmp.w	StorY,d3	; Ar y²=maxY
	ble.s	MaxMix
	move.w	d3,StorY	; y²=maxY
MaxMix	move.w	d4,PyttX
	move.w	d6,StorX

	bsr.w	Rita_linje

RitaEj	dbf	d7,Ritlop2

RitaEj2	sub.w	#1,YtCount
	tst.w	YtCount
	bne.w	Ritloop
;-------------------------------------------------------------------
			PolyFill:
;-------------------------------------------------------------------
	tst.b	KopEj
	bne.w	FyllEj
	moveq	#0,d0
	move.w	storY,d0
	add.w	#10,d0
	mulu	#40*3,d0	; Det är ju descending & Bitplanen ligger
	move.l	d0,BliOff	; efter varandra!!!
	moveq	#0,d0
	move.w	storX,d0
	lsr.w	#4,d0
	add.w	#2,d0
	move.l	d0,d1
	lsl.w	#1,d1
	add.l	d1,BliOff	; Offset fardig!
	add.l	#40*2,BliOff	; Btpl efter varandra!
	move.w	pyttX,d1
	lsr.w	#4,d1
	sub.w	d1,d0
	add.w	#2,d0		; d0 = BltWidth
	move.w	#40,d1
	sub.w	d0,d1
	sub.w	d0,d1		; d1 = Modulo!
	move.w	d1,BliMod
	move.w	storY,d2
	sub.w	pyttY,d2
	add.w	#20,d2
	mulu	#3,d2		; Vi har ju tre bitplan att fylla
	lsl.w	#6,d2		; d2 = BltHeight
	add.w	d2,d0		; d0 = BltSize!
	move.w	d0,BliSize

	move.w	#0,storX
	move.w	#400,pyttX
	move.w	#0,storY
	move.w	#400,pyttY

	move.l	Skarmbuffer,a0
	add.l	BliOff,a0

Wowser	btst	#14,dmaconr
	bne.B	wowser
	move.w	#$09f0,bltcon0	;USEA and D, LFx: D = A
	move.w	#$0012,bltcon1	;Inclusive Fill plus Descending
	move.w	#$ffff,bltafwm	;First- and Last word mask set
	move.w	#$ffff,bltalwm
	move.l	a0,bltapth	;Address of last word of Bit-
	move.l	a0,bltdpth	;plane in the Address-Register
	move.w	BliMod,bltamod	;no Modulo
	move.w	BliMod,bltdmod
	move.w	BliSize,bltsize	;Start Blitter
FyllEj	rts
;-------------------------------------------------------------------
;			Rita_linje:
;-------------------------------------------------------------------
;d0  =  X1   X-coordinate of Start points
;d1  =  Y1   Y-coordinate of Start points
;d2  =  X2   X-coordinate of End points
;d3  =  Y2   Y-coordinate of End points
;a0 must point to the first word of the bitplane
;a1 contains bitplane width in bytes
;a2 word written directly to mask register
;d4 to d6 are used as work registers
;--------------------------------------------------------------------
Octant_table:	dc.b 3,19,11,23,7,27,15,31
;--------------------------------------------------------------------
;Compute the lines starting address

	Rita_linje:

	movem.l	a1-a3,-(sp)

	move.l	Skarmbuffer,a0
	move.l	#40*3,a1
	move.l	#$ffff,a2

	move.l	a1,d4		;Width in work register
	mulu	d1,d4		;Y1 * Bytes per line
	move.w	d0,d5
	lsr.w	#3,d5		;Remainder divided by  8
	add.w	d5,d4		;Y1 * Bytes per line + X1/8
	add.l	a0,d4		;plus starting address of the Bitplane
				;d4 now contains the starting address
				;of the line
				;Compute octants and deltas
	clr.l  d5		;Clear work register
	sub.w  d1,d3		;Y2-Y1  DeltaY from D3
	roxl.b #1,d5		;shift leading char from DeltaY in d5
	tst.w  d3		;Restore N-Flag
	bge.s  y2gy1		;When DeltaY positive, goto y2gy1
	neg.w  d3		;DeltaY invert (if not positive)
y2gy1:	sub.w  d0,d2		;X2-X1  DeltaX to D2
	roxl.b #1,d5		;Move leading char in DeltaX to d5
	tst.w  d2		;Restore N-Flag
	bge.s  x2gx1		;When DeltaX positive, goto x2gx1
	neg.w  d2		;DeltaX invert (if not  positive)
x2gx1:	move.w d3,d1		;DeltaY to d1
	sub.w  d2,d1		;DeltaY-DeltaX
	bge.s  dygdx		;When DeltaY > DeltaX, goto dygdx
	exg    d2,d3		;Smaller Delta goto d2
dygdx:	roxl.b #1,d5		; d5 contains results of 3 comparisons
	move.b Octant_table(pc,d5),d5	;get matching octants
	add.w  d2,d2		;Smaller Delta * 2

;Test, for end of last blitter operation

WBlit:	btst	#14,Dmaconr	;BBUSY-Bit test
	bne.s   WBlit           ;Wait until equal to 0

	move.w d2,Bltbmod	;2* smaller Delta to BLTBMOD
	sub.w  d3,d2            ;2* smaller Delta - larger Delta
	bge.s  signnl           ;When 2* small delta > large delta to signnl
	or.b   #$40,d5          ;Sign flag set
signnl:	sub.w  d3,d2            ;2* smaller Delta - 2* larger Delta
	move.w d2,Bltamod	;to BLTAMOD

;Initialization other info

	move.w #$8000,Bltadat
	move.w a2,Bltbdat	;Mask from a2 in BLTBDAT
	move.w #$ffff,Bltafwm
	andi.w #$000f,d0        ;bottom  4 Bits from  X1

	move.w	d0,d1		;Vilken pixel(0-15)
	not.b	d1

	ror.w  #4,d0            ;to START0-3
	or.w   #$0b4a,d0        ;USEx and LFx set
	lsl.w  #6,d3            ;LENGTH * 64
	add.w  #$42,d3          ;plus (Width = 2)

	move.l	Batplan,d6
Parte	lsr.w	#1,d6
	bcc.B	NoLine

Blutt	btst	#14,dmaconr	; Vi har ju bara tre bitplan
	bne.s	blutt

	move.w d0,Bltcon0
	move.w d5,Bltcon1	;Octant in Blitter
	move.w d2,Bltaptl	;2*small delta-large delta in BLTAPTL
	move.l d4,Bltcpth	;Start address of line to
	move.l d4,Bltdpth	;BLTCPT and BLTDPT
	move.w a1,Bltcmod	;Width of Bitplane in both
	move.w a1,Bltdmod	;Modulo Registers

	movea.l	d4,a3
	bchg	d1,(a3)	

	move.w d3,Bltsize	;Size of bloitt

NoLine	add.l	#40,d4
	tst.w	d6
	bne.s	parte

	movem.l	(sp)+,a1-a3
	rts
	even
;-------------------------------------------------------------------
			Capper:
;-------------------------------------------------------------------
	dc.w	$0100,$3200
	dc.w	$008e,$2c81
	dc.w	$0090,$f4c1
	dc.w	$0090,$28c1
	dc.w	$0092,$0038
	dc.w	$0094,$00d0
	dc.w	$0108,$0050
	dc.w	$010a,$0050

Bitplan	dc.w	$00e0,$0000
	dc.w	$00e2,$0000
	dc.w	$00e4,$0000
	dc.w	$00e6,$0000
	dc.w	$00e8,$0000
	dc.w	$00ea,$0000
	dc.w	$00ec,$0000
	dc.w	$00ee,$0000
	dc.w	$0180,$0000,$0182,$0ffc,$0184,$0ff7,$0186,$0ff0
	dc.w	$0188,$0cc0,$018a,$0aa0,$018c,$0880,$018e,$0660

	dc.w	$0190,$0ade,$0192,$0aaf,$0194,$0fff,$0196,$08cd
	dc.w	$0198,$0fff,$019a,$0fff,$019c,$0fff,$019e,$0fff
	dc.w	$5e07,$fffe
;	dc.w	$0180,$0fff
	dc.w	$5f07,$fffe
;	dc.w	$0180,$0000
	dc.w	$f407,$fffe
;	dc.w	$0180,$0fff
	dc.w	$f507,$fffe
;	dc.w	$0180,$0000
	dc.w	$ffff,$fffe
;-------------------------------------------------------------------
Koords	dc.w	52,90,0		0
	dc.w	104,0,0		4
	dc.w	52,-90,0	8
	dc.w	-52,-90,0	12
	dc.w	-104,0,0	16
	dc.w	-52,90,0	20
	dc.w	0,0,100		24
	dc.w	0,0,-100	28

Ytor	dc.l	3,Yta1,1	; Antal koordinater, Address, FargNr.
	dc.l	3,Yta2,2
	dc.l	3,Yta3,3
	dc.l	3,Yta4,4
	dc.l	3,Yta5,3
	dc.l	3,Yta6,2
	dc.l	3,Yta7,4
	dc.l	3,Yta8,5
	dc.l	3,Yta9,6
	dc.l	3,Yta10,7
	dc.l	3,Yta11,6
	dc.l	3,Yta12,5

Yta1	dc.w	0,4,24,0
Yta2	dc.w	4,8,24,4
Yta3	dc.w	8,12,24,8
Yta4	dc.w	12,16,24,12
Yta5	dc.w	16,20,24,16
Yta6	dc.w	20,0,24,20
Yta7	dc.w	0,28,4,0
Yta8	dc.w	4,28,8,4
Yta9	dc.w	8,28,12,8
Yta10	dc.w	12,28,16,12
Yta11	dc.w	16,28,20,16
Yta12	dc.w	20,28,0,20
;-------------------------------------------------------------------
Xvinkel	dc.w	$100
Yvinkel	dc.w	0
Zvinkel	dc.w	0
Djup	dc.w	2450
ZObs	dc.w	1500
YtCount	dc.w	0
BatPlan	dc.l	0
Offset	dc.l	0
PyttX	dc.w	400
StorX	dc.w	0
PyttY	dc.w	400
StorY	dc.w	0
BliOff	dc.l	0
BliMod	dc.w	0
BliSize	dc.w	0
XOff	dc.w	160
YOff	dc.w	128
XMin	dc.w	0
XMax	dc.w	320
YMin	dc.w	50
YMax	dc.w	198
OldInt		dc.l	0
OldIntEna	dc.w	0

Antalkoords=8
AntalYtor=12

Skarmsize=320/8*256*4
Linjesize=320/8*256
Textsize=320/8*256
Coppersize=Koords-Capper

Allocatesize	dc.l	Coppersize+2*Skarmsize+LinjeSize+TextSize

Roteradekoords	dcb.w	Antalkoords*2,0
Sinus		incbin	SYS:Binary/Sin
		incbin	SYS:Binary/Sin

Skarmen		dc.l	0
Copper		dc.l	0
Skarmbuffer	dc.l	0
Linjebuffer	dc.l	0
Textbuffer	dc.l	0
Oldcopper	dc.l	0
Olddma		dc.w	0
Grafbas		dc.l	0
GrafNamn	dc.b	'graphics.library',0
KopEj		dc.b	0
		even