;       ColorCatch V1.0
;	by Preben Nielsen.
;	Assemble it as case-sensitive.
;	OPT O+
;	OPT O1+		;Tells when a branch could be optimised to short
;	OPT i+		;Tells when '#' is probably missing

NL		=0

CatchID		=0			;Gadget ID's
CreateID	=1
StrID		=2


	incdir	"INCLUDE:"
	include "exec/exec_lib.i"
	include "graphics/view.i"
	include "graphics/graphics_lib.i"
	include "intuition/intuition.i"
	include "intuition/intuition_lib.i"
	include "libraries/dos.i"
	include "libraries/dosextens.i"
	include "libraries/dos_lib.i"
	include "workbench/workbench.i"
	include "workbench/icon_lib.i"

LoadBase	MACRO
		IFNC		'\1','ExecBase'
		movea.l		\1(PC),A6
		ENDC
		IFC		'\1','ExecBase'
		movea.l		4.W,A6
		ENDC
		ENDM
CallLib		MACRO
		jsr		_LVO\1(A6)
		ENDM
Call		MACRO
		bsr		\1
		ENDM
Push		MACRO
		movem.l		\1,-(SP)
		ENDM
Pop		MACRO
		movem.l		(SP)+,\1
		ENDM
Gadget		MACRO
		dc.l		\1
		dc.w		\2,\3,\4,\5,\6,\7,\8
		ENDM
Gadget2		MACRO
		dc.l		\1,\2,\3,\4,\5
		dc.w		\6
		dc.l		\7
		ENDM
Border		MACRO
		dc.w		\1,\2
		dc.b		\3,\4,\5,\6
		dc.l		\7,\8
		ENDM
IntuiText	MACRO
		dc.b		\1,\2,\3,0
		dc.w		\4,\5
		dc.l		TxtAttr1,\6,\7
		ENDM

	SECTION COLORCATCH,CODE
Init		Push		D0-D7/A0-A6
		LoadBase	ExecBase
		suba.l		A1,A1
		CallLib		FindTask		;Find us
		movea.l		D0,A2
		tst.l		pr_CLI(A2)
		bne.S		CLIAndWBStartup
WBenchStartup	lea		pr_MsgPort(A2),A0
		CallLib		WaitPort		;wait for a message
		lea		pr_MsgPort(A2),A0
		CallLib		GetMsg			;then get it
		move.l		D0,WBenchMsg		;save it for later reply
CLIAndWBStartup	lea		DosName(PC),A1
		CallLib		OldOpenLibrary
		move.l		D0,DosBase
		beq.S		Exit
		lea		IntName(PC),A1
		CallLib		OldOpenLibrary
		move.l		D0,IntBase
		beq.S		Exit
		LoadBase	IntBase
		lea		NW(PC),A0
		CallLib		OpenWindow
		move.l		D0,PWindow
		movea.l		D0,A0
		beq.S		Exit
		lea		WinTitle(PC),A1
		lea		ScrTitle(PC),A2
		CallLib		SetWindowTitles
		bra.S		Main
Exit
FreeWindow	LoadBase	IntBase
		move.l		PWindow(PC),D0
		beq.S		FreeIntui
		movea.l		D0,A0
		CallLib		CloseWindow
FreeIntui	LoadBase	ExecBase
		move.l		IntBase(PC),D0
		beq.S		FreeDos
		movea.l		D0,A1
		CallLib		CloseLibrary
FreeDos		move.l		DosBase(PC),D0
		beq.S		ReplyWB
		movea.l		D0,A1
		CallLib		CloseLibrary
ReplyWB		move.l		WBenchMsg(PC),D0
		beq.S		AllDone
		CallLib		Forbid
		movea.l		D0,A1
		CallLib		ReplyMsg		;Reply WBenchMessage if we are started from WB
AllDone		Pop		D0-D7/A0-A6
		moveq		#0,D0
		rts

Main		bra		DoCatch
EventLoop	LoadBase	IntBase
		lea		StrGad(PC),A0
		movea.l		PWindow(PC),A1
		suba.l		A2,A2
		CallLib		ActivateGadget		;Activate String-Gadget
GetNextMsg	LoadBase	ExecBase
		movea.l		PWindow(PC),A0
		movea.l		wd_UserPort(A0),A0
		CallLib		WaitPort
		movea.l		PWindow(PC),A0
		movea.l		wd_UserPort(A0),A0
		CallLib		GetMsg
		tst.l		D0
		beq.S		GetNextMsg
GotAMessage	movea.l		D0,A1
		move.l		im_Class(A1),D7
		move.l		im_IAddress(A1),D6
		CallLib		ReplyMsg
DecodeMessage	cmpi.l		#CLOSEWINDOW,D7
		beq		Exit
		cmpi.w		#GADGETUP,D7
		bne.S		EventLoop

DoGadget	movea.l		D6,A1
		move.w		gg_GadgetID(A1),D0
		beq.S		DoCatch
		subq.w		#1,D0
		beq		DoChange

;The user pressed return while the string-gadget was active
;so we now create an executable file containing the colors
;and maybe an icon
DoSaveAs	lea		CharBuf(PC),A0
		LoadBase	DosBase
		move.l		A0,D1
		move.l		#MODE_NEWFILE,D2
		CallLib		Open
		move.l		D0,D7
		beq.S		DoneSave
		move.l		D7,D1
		lea		ColorExe(PC),A0
		move.l		A0,D2
		move.l		#EndColorExe-ColorExe,D3
		CallLib		Write
		move.l		D7,D1
		CallLib		Close
		move.l		ITxtCreate+12(PC),D0
		lea		TxtCreate1(PC),A1
		cmp.l		A1,D0
		bne.S		DoneSave
		LoadBase	ExecBase		;Save Icon
		lea		IconName(PC),A1
		CallLib		OldOpenLibrary
		move.l		D0,D7
		beq.S		DoneSave
		lea		CharBuf(PC),A0
		lea		MyDiskObject(PC),A1
		move.l		D7,A6
		CallLib		PutIcon
		LoadBase	ExecBase
		move.l		D7,A1
		CallLib		CloseLibrary
DoneSave	bra		EventLoop

;The user clicked the 'Catch colors' gadget
DoCatch		LoadBase	IntBase
		move.l		ib_FirstScreen(A6),A0	;IntuitionBase->FirstScreen
		move.l		sc_ViewPort+vp_ColorMap(A0),A0	;Screen.ViewPort->ColorMap
		move.w		cm_Count(A0),D0		;ColorMap.Count
		move.w		D0,Count
		move.l		cm_ColorTable(A0),A0	;ColorMap->ColorTable
		subq.w		#1,D0
		lea		ColorTab(PC),A1
CopyColor	move.w		(A0)+,(A1)+
		dbf		D0,CopyColor
		bra		EventLoop

;The user clicked the 'Save WITH(OUT) Icon' gadget
DoChange	lea		ITxtCreate+it_IText(PC),A0
		lea		TxtCreate1(PC),A1
		lea		TxtCreate2(PC),A2
		move.l		(A0),D0
		cmp.l		A2,D0
		beq.S		Change
		move.l		A2,A1
Change		move.l		A1,(A0)
		moveq		#1,D0
		lea		CreateGad(PC),A0
		movea.l		PWindow(PC),A1
		suba.l		A2,A2
		LoadBase	IntBase
		CallLib		RefreshGList
		bra		EventLoop

; Write everything between ColorExe and EndColorExe to disk
; (It will be an executable file)
ColorExe	dc.l	$000003F3,$00000000,$00000001,$00000000
		dc.l	$00000000,$00000043,$000003E9,$00000043
		dc.l	$48E7FFFE,$2C780004,$93C94EAE,$FEDA2440
		dc.l	$4AAA00AC,$661641EA,$005C4EAE,$FE8041EA
		dc.l	$005C4EAE,$FE8C23C0,$00000108,$43FA006C
		dc.l	$4EAEFE68,$23C00000,$0100672A,$43FA006D
		dc.l	$4EAEFE68,$23C00000,$0104671A,$20402068
		dc.l	$003C41E8,$002C303A,$006643FA,$00642C7A
		dc.l	$00A04EAE,$FF402C78,$0004203A,$00986706
		dc.l	$22404EAE,$FE62203A,$00886706,$22404EAE
		dc.l	$FE62203A,$0084670A,$4EAEFF7C,$22404EAE
		dc.l	$FE864CDF,$7FFF7000,$4E756772,$61706869
		dc.l	$63732E6C,$69627261,$72790069,$6E747569
		dc.l	$74696F6E,$2E6C6962,$72617279
		dc.w	0
Count		dc.w	0			;Number of colors in ColorTab
ColorTab	dcb.w	32,0			;Array of colors
		dc.l	$00000000,$00000000,$00000000,$000003EC
		dc.l	$00000003,$00000000,$00000028,$00000036
		dc.l	$00000046,$00000000,$000003F2
EndColorExe

DosName		dc.b		'dos.library',0
IntName		dc.b		'intuition.library',0
IconName	dc.b		'icon.library',0

		EVEN
DosBase		dc.l		0
IntBase		dc.l		0
WBenchMsg	dc.l		0
PWindow		dc.l		0

;--- Window and gadgets
NW		dc.w		180,15,303,62
		dc.b		0,1
		dc.l		GADGETUP!CLOSEWINDOW,WINDOWCLOSE!WINDOWDRAG!WINDOWDEPTH!ACTIVATE!RMBTRAP!NOCAREREFRESH,GadgetList,0,0,0,0
		dc.w		0,0,0,0,WBENCHSCREEN

BWIDTH		=282
BHEIGHT		=11
BBorder		Border		-2,-1,3,0,1,9,BVectors,NL
BVectors	dc.w		2,0,BWIDTH+1,0,BWIDTH+3,2,BWIDTH+3,BHEIGHT-1,BWIDTH+1,BHEIGHT+1,2,BHEIGHT+1,0,BHEIGHT-1,0,2,2,0
STRWIDTH	=219
STRHEIGHT	=10
StrBorder	Border		-3,-3,3,0,1,9,StrBVectors,NL
StrBVectors	dc.w		2,0,STRWIDTH,0,STRWIDTH+2,2,STRWIDTH+2,STRHEIGHT,STRWIDTH,STRHEIGHT+2,2,STRHEIGHT+2,0,STRHEIGHT,0,2,2,0

GadgetList
CatchGad	Gadget		StrGad,10,15,BWIDTH,BHEIGHT,GADGHCOMP,RELVERIFY,BOOLGADGET
		Gadget2		BBorder,NL,ITxtCatch,NL,NL,CatchID,NL
StrGad		Gadget		CreateGad,75,32,STRWIDTH,STRHEIGHT,GADGHCOMP,RELVERIFY,STRGADGET
		Gadget2		StrBorder,NL,ITxtSaveAs,NL,StrInfo,StrID,NL
CreateGad	Gadget		NL,10,45,BWIDTH,BHEIGHT,GADGHCOMP,RELVERIFY,BOOLGADGET
		Gadget2		BBorder,NL,ITxtCreate,NL,NL,CreateID,NL

StrInfo		dc.l		CharBuf,NL
		dc.w		NL,60,NL,NL,NL,NL,NL,NL
		dc.l		NL,NL,NL

CharBuf		dcb.b		60,0
		EVEN

ITxtCatch	IntuiText	1,0,1,4,2,TxtCatch,NL
ITxtSaveAs	IntuiText	1,0,1,-65,0,TxtSaveAs,NL
ITxtCreate	IntuiText	1,0,1,74,2,TxtCreate1,NL

TxtCatch	dc.b		'Catch colors from frontmost screen',0
TxtSaveAs	dc.b		'Save as',0
TxtCreate1	dc.b		'  Save WITH Icon ',0
TxtCreate2	dc.b		'Save WITHOUT Icon',0

ScrTitle	dc.b		'ColorCatch V1.0 by Preben Nielsen in 1990. This is Public Domain',0
WinTitle	dc.b		'ColorCatch V1.0',0

FontName	dc.b		'topaz.font',0
		EVEN

TxtAttr1	dc.l		FontName
		dc.w		TOPAZ_EIGHTY
		dc.b		FS_NORMAL,FPB_ROMFONT
		EVEN

; The rest is  for the icon
MyDiskObject	dc.w		WB_DISKMAGIC,WB_DISKVERSION
		dc.l		0
		dc.w		0,0,60,10
		dc.w		GADGIMAGE!GADGHIMAGE,RELVERIFY!GADGIMMEDIATE,BOOLGADGET
		dc.l		Image1,Image2,0,0,0
		dc.w		0
		dc.l		0
		dc.b		WBTOOL,0	
		dc.l		0,0,100,40,0,0,0

Image1		dc.w		0,0		; LeftEdge, TopEdge
		dc.w		60,10		; Width, Height
		dc.w		2		; Depth
		dc.l		ImageData1	; ImageData
		dc.b		3,0		; PlanePick, PlaneOnOff
		dc.l		0		; Next Image

Image2		dc.w		0,0		; LeftEdge, TopEdge
		dc.w		60,10		; Width, Height
		dc.w		2		; Depth
		dc.l		ImageData2	; ImageData
		dc.b		3,0		; PlanePick, PlaneOnOff
		dc.l		0		; Next Image

ImageData1	dc.w	$7fe0,$0fe0,$0000,$0000,$e070,$0c60,$0000 ;Plane 0
		dc.w	$0000,$c73f,$fc6f,$ffff,$ffe0,$c7ff,$fc7f
		dc.w	$fe03,$ffe0,$c63f,$fc7f,$fe39,$ffe0,$c7ff
		dc.w	$fc7f,$fe3f,$ffe0,$c73f,$fc7f,$fe31,$ffe0
		dc.w	$e07f,$fe1f,$fe31,$ffe0,$7fff,$ffff,$fff1
		dc.w	$ffc0,$0000,$0000,$0000,$0000
		dc.w	$0000,$0000,$0000,$0000,$1f80,$0380,$0000 ;Plane 1
		dc.w	$0000,$38c0,$0380,$0000,$0000,$3807,$e383
		dc.w	$f1fc,$3f80,$380e,$3387,$19c6,$7000,$380e
		dc.w	$3387,$19c0,$3f00,$38ce,$3387,$19c0,$0380
		dc.w	$1f87,$e1e3,$f1c0,$7f00,$0000,$0000,$0000
		dc.w	$0000,$0000,$0000,$0000,$0000

ImageData2	dc.w	$7fe0,$0fe0,$0000,$0000,$fff0,$0fe0,$0000 ;Plane 0
		dc.w	$0000,$ffff,$ffef,$ffff,$ffe0,$fff8,$1ffc
		dc.w	$0fff,$c060,$fe31,$cff8,$e7ff,$8fe0,$fff1
		dc.w	$cff8,$e7ff,$c0e0,$fff1,$cff8,$e7f1,$fc60
		dc.w	$fff8,$1ffc,$0ff1,$80e0,$7fff,$ffff,$fff1
		dc.w	$ffc0,$0000,$0000,$0000,$0000
		dc.w	$0000,$0000,$0000,$0000,$1f80,$0380,$0000 ;Plane 1
		dc.w	$0000,$38c0,$0380,$0000,$0000,$3807,$e383
		dc.w	$f1fc,$3f80,$380e,$3387,$19c6,$7000,$380e
		dc.w	$3387,$19c0,$3f00,$38ce,$3387,$19c0,$0380
		dc.w	$1f87,$e1e3,$f1c0,$7f00,$0000,$0000,$0000
		dc.w	$0000,$0000,$0000,$0000,$0000
		END