;	FAST! Rotate von Florian Schroecker und
;			 Florian Sauer

; That's really quick and dirty... however it uses the C2P stuff,... and maybe
; it's usefully for someone somehow....

;---------------------------------------------------------------------------------
;INCLUDE's
;---------------------------------------------------------------------------------

	mc68020

	INCLUDE "exec/types.i"
	INCLUDE "exec/memory.i"
        INCLUDE "libraries/dos.i"
        INCLUDE "libraries/dosextens.i"
	INCLUDE "utility/tagitem.i"
        INCLUDE "lvo/exec.i"
        INCLUDE "lvo/dos.i"
        INCLUDE "lvo/gfxbase.i"
	INCLUDE "lvo/intuition.i"
	INCLUDE "intuition/screens.i"
	INCLUDE "intuition/intuition.i"
	INCLUDE "intuition/intuitionbase.i"
	INCLUDE "graphics/rastport.i"
	INCLUDE "graphics/gfxbase.i"
;---
;Rotate Macros
;---
FeedLine:	macro
	move.b		$0001(a3),d0		;warp engine....
	lsl.w		d1,d0
	move.b		$0001(a3),d0
	swap		d0			;prob: put 4 bytes as longword ....
	move.b		$0001(a3),d0		;~~~~~ arghhhh !!!
	lsl.w		d1,d0
	move.b		$0001(a3),d0
	move.l		d0,(a1)

	move.b		$0001(a3),d0
	lsl.w		d1,d0
	move.b		$0001(a3),d0
	swap		d0
	move.b		$0001(a3),d0
	lsl.w		d1,d0
	move.b		$0001(a3),d0
	move.l		d0,(a1)

	move.b		$0001(a3),d0
	lsl.w		d1,d0
	move.b		$0001(a3),d0
	swap		d0
	move.b		$0001(a3),d0
	lsl.w		d1,d0
	move.b		$0001(a3),d0
	move.l		d0,(a1)

	move.b		$0001(a3),d0
	lsl.w		d1,d0
	move.b		$0001(a3),d0
	swap		d0
	move.b		$0001(a3),d0
	lsl.w		d1,d0
	move.b		$0001(a3),d0
	move.l		d0,(a1)

	move.b		$0001(a3),d0
	lsl.w		d1,d0
	move.b		$0001(a3),d0
	swap		d0
	move.b		$0001(a3),d0
	lsl.w		d1,d0
	move.b		$0001(a3),d0
	move.l		d0,(a1)

	move.b		$0001(a3),d0
	lsl.w		d1,d0
	move.b		$0001(a3),d0
	swap		d0
	move.b		$0001(a3),d0
	lsl.w		d1,d0
	move.b		$0001(a3),d0
	move.l		d0,(a1)

	move.b		$0001(a3),d0
	lsl.w		d1,d0
	move.b		$0001(a3),d0
	swap		d0
	move.b		$0001(a3),d0
	lsl.w		d1,d0
	move.b		$0001(a3),d0
	move.l		d0,(a1)

	move.b		$0001(a3),d0
	lsl.w		d1,d0
	move.b		$0001(a3),d0
	swap		d0
	move.b		$0001(a3),d0
	lsl.w		d1,d0
	move.b		$0001(a3),d0
	move.l		d0,(a1)

	endm
;---
;Constants
;---
NULL		equ	0		;null
;---
;Macro Definitions...
;---
clear:	macro				;clear dn
	moveq		#0,\1		;clear it
	endm				;thats all

Line:	macro				;LINE x1,y1,x2,y2
	move.l		myRastPort(pc),a1 ;rastport in a1
	move.l		myGfxBase(pc),a6 ;graphics.libary
	move.l		#\1,d0		;x_pos
	move.l		#\2,d1		;y_pos
	jsr		Move(a6)	;move x1,y1
	move.l		#\3,d0		;to x_pos
	move.l		#\4,d1		;to y_pos
	jsr		Draw(a6)	;drawto x,y
	endm				;thats all folks

CallExec: macro
	move.l		4,a6
	jsr		_LVO\1(a6)
	endm

Call:	MACRO				;call's system
	IFEQ		NARG-2
	move.l  	\2(pc),a6
	ENDC
	IFLE		NARG-2
	jsr     	_LVO\1(a6)
	MEXIT
	ENDC
	FAIL    	CALL MACRO ERROR
	ENDM

sec:		MACRO				;set carry
		ori.b	#1,CCR
		ENDM

clc:		MACRO				;clear carry
		andi.b	#$FE,CCR
		ENDM
;---
;Start Code & Window Stuff ! 
;---
	jmp		Start		;go!
;---
;SCREENS AND WINDOWS
;---
NewScreenStructure:
	dc.w	0,0	;screen XY origin relative to View
sz1:	dc.w	320,256	;screen width and height
deep:	dc.w	8	;screen depth (number of bitplanes)
	dc.b	2,1	;detail and block pens
smd:	dc.w	0*(V_HIRES+V_LACE)	;display modes for this screen
	dc.w	CUSTOMSCREEN+NS_EXTENDED	;screen type
	dc.l	0	;pointer to default screen font
	dc.l	NewScreenName	;screen title
	dc.l	NULL	;first in list of custom screen gadgets
	dc.l	NULL	;pointer to custom BitMap structure
	dc.l	tags
NewScreenName:
	dc.b	'FAST! Rotate © 1994 by FWS',0
	cnop 0,2

tags: dc.l	SA_Interleaved,-1
      dc.l	TAG_DONE,0


NewWindowStructure1:
	dc.w	0,0	;window XY origin relative to TopLeft of screen
sz2:	dc.w	320,256	;window width and height
	dc.b	0,1	;detail and block pens
	dc.l	0	;IDCMP flags
	dc.l	ACTIVATE+RMBTRAP+BACKDROP+BORDERLESS	;other window flags
	dc.l	0	;first gadget in gadget list
	dc.l	NULL	;custom CHECKMARK imagery
	dc.l	0	;window title
myScreen:
	dc.l	NULL	;custom screen pointer
	dc.l	NULL	;custom bitmap
	dc.w	5,5	;minimum width and height
	dc.w	-1,-1	;maximum width and height
	dc.w	CUSTOMSCREEN	;destination screen type
;---
;Bit's & Byte's
;---
OldWindowPTR:	dc.l	0
IntBase:	dc.l	0		;lib bases
DosBase:	dc.l	0
myGfxBase:	dc.l	0
ExecBase:	dc.l	0
WindowBase:	dc.l	0		;our window
ReturnMsg:	dc.l	0		;& temp shite
myRastPort:	dc.l	0

DosName:	dc.b	"dos.library",0
IntName:	dc.b	"intuition.library",0
GfxName:	dc.b	"graphics.library",0
		even

myBitMap:	dc.l	0		;for direct access
Plane1:		dc.l	0
Plane2:		dc.l	0
Plane3:		dc.l	0
Plane4:		dc.l	0
Plane5:		dc.l	0
Plane6:		dc.l	0
Plane7:		dc.l	0
Plane8:		dc.l	0

ScreenX:	dc.w	320
ScreenY:	dc.w	256

;-----------------------------------------------------------------------
;AGA ROTATE		      © 1993/4 by Infernal Byte, written by FWS!
;-----------------------------------------------------------------------
myfunc:	moveq		#0,d0
	rts

Start:	move.l		4,ExecBase
	bsr		InitColMap
	bsr		OpenAll		;open all libraries
	bcs		m_Quit

	move.l		IntBase(pc),a0
	move.l		#myfunc,-210+2(a0)

	bsr		OpenDisplay	;open it!(screen etc.)
	bcs.s		err
	bsr		InitPicture
	bsr		MainLoop
err:	bsr		CloseDisplay	;close screen,window etc...
	bsr		CloseAll	;close all libraries
	clear		d0		;AmigaDos return value
	rts				;back to nowhere

m_Quit:	moveq		#20,d0
	rts

OpenAll:lea		GfxName(pc),a1		;open the gfx.library
	moveq		#40,d0
	CallExec 	OpenLibrary		;open it.
	move.l		d0,myGfxBase		;save base
	lea		IntName(pc),a1		;open the int.library
	moveq		#40,d0
	Call		OpenLibrary		;open it.
	move.l		d0,IntBase		;save base
	lea		DosName(pc),a1		;open the int.library
	moveq		#40,d0
	Call		OpenLibrary		;open it.
	move.l		d0,DosBase		;save base
	bne.s		oa_Ok
	sec
	rts
oa_Ok:	clc
	rts				;back to system

CloseAll:
	move.l		IntBase(pc),a1
	CallExec	CloseLibrary
	move.l		DosBase(pc),a1
	CallExec	CloseLibrary
	move.l		myGfxBase(pc),a1
	CallExec	CloseLibrary
	rts					;back to system

nullpnt:	dc.l 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

OpenDisplay:
	lea		NewScreenStructure(pc),a0
	Call		OpenScreen,IntBase
	move.l		d0,myScreen

	clear		d0
	move.l		myScreen(pc),a0
	Call		ShowTitle,IntBase

	lea		NewWindowStructure1(pc),a0	;open window
	Call		OpenWindow,IntBase
	move.l		d0,WindowBase			;save windowbase
	move.l		d0,a0
	lea		nullpnt,a1
	moveq		#1,d0
	moveq		#16,d1
	moveq		#0,d2
	moveq		#0,d3
	Call		SetPointer

	suba.l		a1,a1			
	CallExec	FindTask
	move.l		d0,a0
	move.l		pr_WindowPtr(a0),OldWindowPTR
	move.l		WindowBase(pc),pr_WindowPtr(a0)

	move.l		WindowBase(pc),a0
	move.l		wd_RPort(a0),myRastPort
	move.l  	wd_RPort(a0),a0
	move.l  	4(a0),myBitMap
	move.l		myBitMap(pc),a0

	move.l		08(a0),Plane1
	move.l		12(a0),Plane2
	move.l		16(a0),Plane3
	move.l		20(a0),Plane4
	move.l		24(a0),Plane5
	move.l		28(a0),Plane6
	move.l		32(a0),Plane7
	move.l		36(a0),Plane8

	move.l		myRastPort(pc),a1
	moveq		#1,d0
	Call		SetAPen,myGfxBase

	move.l		myGfxBase(pc),a0
	move.l		gb_ChunkyToPlanarPtr(a0),d0
	move.l		d0,C2P
	beq.s		error
	clc
	rts
error:	sec
	rts

C2P:	dc.l	0

CloseDisplay:
	move.l		WindowBase(pc),a0	;close window now!
	Call		CloseWindow,IntBase	;do it!
	move.l		myScreen(pc),a0
	Call		CloseScreen
	rts

;-------------------------------------------------------------------------------
;Main Loop
;-------------------------------------------------------------------------------

Angle:		dc.w	0	;[0..255]
SourceSize:	dc.w	32	;size in pixels	
timer:		dc.w	0

MainLoop:
	move.l		#SuperCode,$80.w
	bsr		SetUpColors

DrawLoop:
	addq.w		#1,timer
	cmpi.w		#30*20,timer
	beq		qqq

	Call		WaitTOF,myGfxBase
	addq.w		#1,Angle
	andi.w		#$01ff,Angle
	move.l		Plane1(pc),a5
	lea		12+(64*320)(a5),a5
	move.w		Angle(pc),d0
	bsr		DrawObject

	btst		#7,$bfe001
	beq		dl_Quit
	btst		#6,$bfe001
	bne.s		DrawLoop
qqq:	nop
dl_Quit:rts

DrawObject:
	lea		IMAGE+1024(pc),a0		;start of 48x48 image data
	move.l		C2P(pc),a1			;this is CD³² support
	lea		OFFSETS,a2			;how to rotate [code] ...
	moveq		#8,d1

	andi.l		#$1ff,d0
	mulu		#512,d0				;*((32+32)*2)
	adda.l		d0,a2
	lea		r_ModCode+2(pc),a4		;modify code!
	moveq		#127,d2
	clear		d0
r_CreateCode:
	move.w		(a2)+,(a4)
	lea		6(a4),a4			;seek to next command...
	addq.w		#1,d0
	andi.w		#31,d0
	bne.s		aka
	lea		(sd2-sd1)(a4),a4
aka:	dbf		d2,r_CreateCode
	clr.w		sd1+2
	trap		#0				;flush cache

	moveq		#127,d2
r_DrawLine:
	move.l		a0,a3				;get a copy of image start
	clear		d0
	move.w		(a2)+,d0
	adda.l		d0,a3
r_ModCode:
	FeedLine					;copy one line into the c2p hw
sd1	move.l		(a1),77(a5)			;write to bitplane...
	move.l		(a1),40(a5)			;write to bitplane...
	move.l		(a1),80(a5)			;write to bitplane...
	move.l		(a1),120(a5)			;write to bitplane...
	move.l		(a1),160(a5)			;write to bitplane...
	move.l		(a1),200(a5)			;write to bitplane...
;	move.l		(a1),240(a5)			;write to bitplane...
;	move.l		(a1),280(a5)			;write to bitplane...
sd2
	FeedLine					;copy one line into the c2p hw
	move.l		(a1),4(a5)			;write to bitplane...
	move.l		(a1),44(a5)			;write to bitplane...
	move.l		(a1),84(a5)			;write to bitplane...
	move.l		(a1),124(a5)			;write to bitplane...
	move.l		(a1),164(a5)			;write to bitplane...
	move.l		(a1),204(a5)			;write to bitplane...
;	move.l		(a1),244(a5)			;write to bitplane...
;	move.l		(a1),284(a5)			;write to bitplane...

	FeedLine					;copy one line into the c2p hw
	move.l		(a1),8(a5)			;write to bitplane...
	move.l		(a1),48(a5)			;write to bitplane...
	move.l		(a1),88(a5)			;write to bitplane...
	move.l		(a1),128(a5)			;write to bitplane...
	move.l		(a1),168(a5)			;write to bitplane...
	move.l		(a1),208(a5)			;write to bitplane...
;	move.l		(a1),248(a5)			;write to bitplane...
;	move.l		(a1),288(a5)			;write to bitplane...

	FeedLine					;copy one line into the c2p hw
	move.l		(a1),12(a5)			;write to bitplane...
	move.l		(a1),52(a5)			;write to bitplane...
	move.l		(a1),92(a5)			;write to bitplane...
	move.l		(a1),132(a5)			;write to bitplane...
	move.l		(a1),172(a5)			;write to bitplane...
	move.l		(a1),212(a5)			;write to bitplane...
;	move.l		(a1),252(a5)			;write to bitplane...
;	move.l		(a1),292(a5)			;write to bitplane...

	lea		320(a5),a5
	dbf		d2,r_DrawLine
	rts

SuperCode:
	moveq		#%1001,d0
	movec		d0,CACR			;flush int.cache, cause of selfmod code...
	rte
;---
;Routines © 1994 by Flørian W. Sauer
;---
SetUpColors:
	lea		IMAGE(pc),a2
	move.l		#255,d7
sup_loop:
	clear		d1
	clear		d2
	clear		d3
	move.w		(a2),d1
	andi.w		#$0f00,d1
	ror.l		#6,d1
	ror.l		#6,d1
	move.w		(a2),d2
	andi.w		#$00f0,d2
	ror.l		#8,d2
	move.w		(a2)+,d3
	andi.w		#$000f,d3
	ror.l		#4,d3

	clear		d0
	move.w		(a2),d0
	andi.w		#$0f00,d0
	ror.l		#8,d0
	ror.l		#8,d0
	or.l		d0,d1
	clear		d0
	move.w		(a2),d0
	andi.w		#$00f0,d0
	ror.l		#6,d0
	ror.l		#6,d0
	or.l		d0,d2
	clear		d0
	move.w		(a2)+,d0
	andi.w		#$000f,d0
	ror.l		#8,d0
	or.l		d0,d3

	move.l		myScreen(pc),a0
	lea		sc_ViewPort(a0),a0
	move.l		#255,d0
	sub.l		d7,d0
	Call		SetRGB32,myGfxBase
	dbf		d7,sup_loop
	rts

InitPicture:
	lea		PICTURE1,a0
	cmpi.l		#"PIC1",0
	beq.s		ip_Right
	lea		PICTURE2,a0
ip_Right:
	move.w		#255,d7
ip_EachLine:
	moveq		#2*10-1,d6
	move.w		#255,d0
	sub.w		d7,d0
	mulu		#320*8/8,d0
	move.l		Plane7(pc),a1
	adda.l		d0,a1
ip_Copy2Planes:
	move.l		(a0)+,(a1)+
	dbf		d6,ip_Copy2Planes
	dbf		d7,ip_EachLine
	rts

InitColMap:
	lea		PALETTE+4,a0
	lea		IMAGE+256,a1
	move.w		#3-1,d7
icm_CopyColors:
	move.l		(a0)+,d2
	lea		IMAGE+4,a2
	moveq		#64-2,d6
	move.l		d2,(a1)+		;copy one real color for no background
icm_Repeat:
	move.l		(a2)+,d0
	lsr.l		#2,d0
	andi.l		#$03330333,d0
	move.l		d2,d1
	lsr.l		#1,d1
	andi.l		#$07770777,d1
	add.l		d1,d0
	move.l		d0,(a1)+
	dbf		d6,icm_Repeat
	dbf		d7,icm_CopyColors
	rts

;--------------
;DATA AREA !!!!
;--------------

IMAGE:		incbin	"chunkytest_big3.cpl"
		cnop	0,4
OFFSETS:	incbin	"dreh128.dat"
PALETTE:	incbin	"palette.asm"
PICTURE1:	incbin	"demo1.fbb"
PICTURE2:	incbin	"demo2.fbb"
	END