***************************************************
	*        HAM8 Beispielprogramm (10.2.1993)        *
	*     von Alexander Kochann und Oliver Reiff      *
	*	     laden mit DevPacII 	      *
	*               tabulator size: 11	      *
	***************************************************

Red		equ	%10000000
Green		equ	%11000000
Blue		equ	%01000000

FALSE		equ	0
TRUE		equ	1
TAG_DONE		equ	0

CloseScreen	equ	-66
CloseWindow	equ	-72
InitRastPort	equ	-198
Wait		equ	-318
GetMsg		equ	-372
InitBitMap		equ	-390
CloseLibrary	equ	-414
OpenLibrary	equ	-552
OpenWindowTagList	equ	-606
OpenScreenTagList	equ	-612
NewObjectA		equ	-636
DisposeObject	equ	-642
WritePixelArray8	equ	-786
SetWindowPointerA	equ	-816
LoadRGB32		equ	-882
AllocBitMap	equ	-918
FreeBitMap		equ	-924

wd_RPort		equ	50
wd_UserPort	equ	86
im_Class		equ	20
rp_SIZEOF		equ	100
bm_SIZEOF		equ	40
sc_ViewPort	equ	44
sc_RastPort	equ	84
gb_ChipRevBits0	equ	236

SA_Colors		equ	$80000029
SA_DisplayID	equ	$80000032
SA_Pens		equ	$8000003a
SA_Parent		equ	$8000003d
SA_Draggable	equ	$8000003e
SA_Interleaved	equ	$80000042
WA_NewLookMenus	equ	$80000093
WA_Pointer		equ	$80000097
WA_BusyPointer	equ	$80000098
WA_PointerDelay	equ	$80000099
POINTERA_BitMap	equ	$80039001
POINTERA_XOffset	equ	$80039002
POINTERA_YOffset	equ	$80039003
POINTERA_WordWidth	equ	$80039004
POINTERA_XResolution	equ	$80039005
POINTERA_YResolution	equ	$80039006

*--------------------------------

PrgStart	opt	o+
	move.l	4.w,a6
	lea	GfxName,a1
	moveq	#39,d0
	jsr	OpenLibrary(a6)
	lea	GfxBase,a0
	move.l	d0,(a0)
	beq	WrongKick
	lea	IntName,a1
	moveq	#39,d0
	jsr	OpenLibrary(a6)
	lea	IntBase,a0
	move.l	d0,(a0)

	move.l	GfxBase,a6
	move.b	gb_ChipRevBits0(a6),d0
	and.b	#$f,d0		* AA-Chipset vorhanden
	cmp.b	#$f,d0		* und aktiviert ?
	bne	NoScreen

	move.l	IntBase,a6
	lea	ScreenData_1,a0
	lea	ScreenTags_1,a1
	jsr	OpenScreenTagList(a6)
	lea	Screen_1,a0
	move.l	d0,(a0)
	beq	NoScreen

	lea	WindowData_1,a0
	lea	WindowTags_1,a1
	jsr	OpenWindowTagList(a6)
	lea	Window_1,a0
	move.l	d0,(a0)

	lea	ScreenData_2,a0
	lea	ScreenTags_2,a1
	move.l	Screen_1,4(a1)
	jsr	OpenScreenTagList(a6)
	lea	Screen_2,a0
	move.l	d0,(a0)

	move.l	GfxBase,a6
	move.w	#640,d0
	moveq	#2,d1
	moveq	#8,d2
	moveq	#0,d3
	sub.l	a0,a0
	jsr	AllocBitMap(a6)
	lea	TempBM,a0
	move.l	d0,(a0)
	beq	NoBitMap

	lea	TempRP,a1
	jsr	InitRastPort(a6)

	lea	TempRP,a1
	move.l	TempBM,4(a1)

	bsr	DrawGrey
	bsr	DrawColors

	lea	PointerBM,a0
	moveq	#2,d0
	moveq	#16,d1
	moveq	#16,d2
	jsr	InitBitMap(a6)
	lea	PointerBM,a1
	lea	PointerPlane0,a0
	move.l	a0,8(a1)		* Erste BitPlane
	lea	PointerPlane1,a0
	move.l	a0,12(a1)		* Zweite BitPlane

	lea	SpriteTags,a2
	move.l	a1,4(a2)
	lea	PointerClass,a1
	sub.l	a0,a0
	move.l	IntBase,a6
	jsr	NewObjectA(a6)
	lea	ExtSprite,a0
	move.l	d0,(a0)

	move.l	Window_1,a0
	lea	PointerTags,a1
	move.l	ExtSprite,4(a1)
	move.l	IntBase,a6
	jsr	SetWindowPointerA(a6)

*---------------------

MainLoop	move.l	4.w,a6
	moveq	#-1,d0
	jsr	Wait(a6)

	move.l	Window_1,a0
	move.l	wd_UserPort(a0),a0
	jsr	GetMsg(a6)
	tst.l	d0
	beq.s	MainLoop
	move.l	d0,a0
	move.l	im_Class(a0),d0
	cmp.l	#$200,d0		* CloseWindow
	bne.s	MainLoop

*---------------------

Ende	move.l	GfxBase,a6
	move.l	TempBM,a0
	jsr	FreeBitMap(a6)
NoBitMap	move.l	IntBase,a6
	move.l	Window_1,a0
	jsr	CloseWindow(a6)
	move.l	Screen_2,a0
	jsr	CloseScreen(a6)
	move.l	Screen_1,a0
	jsr	CloseScreen(a6)
	move.l	ExtSprite,a0
	jsr	DisposeObject(a6)
NoScreen	move.l	4.w,a6
	move.l	IntBase,a1
	jsr	CloseLibrary(a6)
	move.l	GfxBase,a1
	jmp	CloseLibrary(a6)
*----------
WrongKick	moveq	#20,d0
	rts

*---------------------

DrawGrey	lea	Grey,a0
	move.w	#255,d0
	move.w	#256,(a0)+		* 256 Einträge
	clr.w	(a0)+		* Mit Color0 starten
	moveq	#0,d2
.Loop_1	moveq	#11,d1
.Loop_2	move.b	d2,(a0)+
	dbra	d1,.Loop_2
	addq.w	#1,d2
	dbra	d0,.Loop_1

	move.l	Screen_2,a0
	lea	sc_ViewPort(a0),a0
	lea	Grey,a1
	move.l	gfxbase,a6
	jsr	LoadRGB32(a6)

	lea	Pixels,a4
	moveq	#19,d0
.Loop_3	move.w	#255,d1
.Loop_4	move.b	d1,(a4)+
	dbra	d1,.Loop_4
	dbra	d0,.Loop_3

	lea	TempRP,a1
	lea	Pixels,a2
	move.l	Screen_2,a0
	lea	sc_RastPort(a0),a0
	moveq	#32,d0
	moveq	#0,d1
	move.w	#287,d2
	move.w	#20,d3
	jmp	WritePixelArray8(a6)

*---------------------

DrawColors	lea	Pixels,a4
	move.w	#Blue,d0
	move.w	#Red,d1
	move.w	#Green,d2
	bsr.s	DrawCBox
	move.w	#Green,d0
	move.w	#Blue,d1
	move.w	#Red,d2
	bsr.s	DrawCBox

	lea	TempRP,a1
	lea	Pixels,a2
	move.l	Window_1,a0
	move.l	wd_RPort(a0),a0
	moveq	#0,d0
	moveq	#0,d1
	move.w	#255,d2
	move.w	#193,d3
	jmp	WritePixelArray8(a6)

*---------------------

DrawCBox	move.w	#63,d7
.Loop	moveq	#63,d4
	sub.w	d7,d4
	and.w	#%00111111,d4
	or.w	d0,d4
	move.b	d4,(a4)+
	move.w	d1,d4
	bsr.s	DrawLine
	move.w	d2,d4
	bsr.s	DrawLine
	move.w	d1,d4
	or.w	#%111111,d4
	bsr.s	DrawLine
	move.w	d2,d4
	or.w	#%111111,d4
	bsr.s	DrawLine
	subq.l	#1,a4
	dbra	d7,.loop
	rts
*----------
DrawLine	movem.l	d0-d4,-(sp)
	move.w	#63,d6
	moveq	#1,d1
	move.w	d4,d0
	and.w	#%00111111,d0
	beq.s	.Loop
	moveq	#-1,d1
.Loop	move.b	d4,(a4)+
	add.w	d1,d4
	dbra	d6,.loop
	movem.l	(sp)+,d0-d4
	rts

*-------------------------------------------
*-------------------------------------------

IntBase	dc.l	0
GfxBase	dc.l	0
Window_1	dc.l	0
Screen_2	dc.l	0
TempBM	dc.l	0
ExtSprite	dc.l	0

ScreenData_1
	dc.w	0,0,640,170,8,1,0,$f
	dc.l	Topaz8,ScreenName,0,0
ScreenData_2
	dc.w	0,180,320,21,8,1,0,$11f
	dc.l	Topaz8,0,0,0

WindowData_1
	dc.w	188,20,264,141,1
	dc.l	$200,$3140e,0,0,WindowName
Screen_1	dc.l	0,0
	dc.w	50,50,320,200,15

WindowTags_1
	dc.l	WA_BusyPointer,TRUE
	dc.l	TAG_DONE
ScreenTags_1
	dc.l	SA_Pens,PenArray
	dc.l	SA_DisplayID,$29800
	dc.l	SA_Colors,ColorSpec
	dc.l	SA_Interleaved,TRUE
	dc.l	TAG_DONE
ScreenTags_2
	dc.l	SA_Parent,0
	dc.l	SA_DisplayID,$21000
	dc.l	SA_Colors,ColorSpec
	dc.l	SA_Draggable,FALSE
	dc.l	TAG_DONE
PointerTags
	dc.l	WA_Pointer,0
	dc.l	WA_PointerDelay,TRUE
	dc.l	TAG_DONE
SpriteTags
	dc.l	POINTERA_BitMap,0
	dc.l	POINTERA_XOffset,-6
	dc.l	POINTERA_WordWidth,4
	dc.l	POINTERA_XResolution,4
	dc.l	POINTERA_YResolution,2
	dc.l	TAG_DONE

ColorSpec	dc.w	0,$99,$99,$99
	dc.w	1,$00,$00,$00
	dc.w	2,$ff,$ff,$ff
	dc.w	3,$44,$66,$bb
	dc.w	4,$f0,$e8,$00
	dc.w	17,$ee,$00,$00
	dc.w	18,$00,$00,$00
	dc.w	19,$ee,$dd,$cc
	dc.w	-1

PenArray	dc.w	0,0,1,2,1,3,4,0,2,1,2,1,-1

Topaz8	dc.l	FontName
	dc.w	8,0

PointerClass
	dc.b	'pointerclass',0
IntName	dc.b	'intuition.library',0
GfxName	dc.b	'graphics.library',0
FontName	dc.b	'topaz.font',0
ScreenName	dc.b	'Hires-HAM8 Screen',0
WindowName	dc.b	'Farbverlauf',0

	SECTION	'Buffers',BSS_C
PointerBM	ds.b	bm_SIZEOF
TempRP	ds.b	rp_SIZEOF
Pixels	ds.b	400*210
Grey	ds.b	256*12+4

	SECTION	'Sprite Data',DATA_C
PointerPlane0
	dc.w	$0180,$0180,$0180,$0ff0,$3ffc,$7ffe,$ffff,$ffff
	dc.w	$ffff,$ffff,$ffff,$ffff,$7ffe,$7ffe,$3ffc,$0ff0
PointerPlane1
	dc.w	$0c60,$3e70,$6018,$0000,$0000,$0660,$0440,$0000
	dc.w	$0000,$0000,$0000,$0ef0,$07e0,$0340,$0000,$0000