*	ColorCatch
*	By Preben Nielsen
*
*	NOTE:	There's no need to 'RUN' or 'RUNBACK' this program from the
*		CLI. It is auto-detaching.
*
*HISTORY
*          Made with Hisoft V2.12
*
*  V1.0   ??-???-90: First release.
*  V2.0   06-Aug-91: Rewrote the code just for fun.
*                    The executables created are now even smaller.
*                    The user-interface is now completely different from
*                    version 1.0.
*                    Is now auto-detaching when run from the CLI.
*                    The executables created by this program can now be
*                    made resident (pure).
*                    Works fine with kickstart 2.x (68000 based).

	OPT O+
	OPT O1+			; Tells when a branch could be optimised to short
	OPT i+			; Tells when '#' is probably missing

		incdir		"AsmInc:"
		include		"P.i"
		include		"Intui.i"
		include		"Detach.i"
		include		"relMacros.i"
		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"

FileBufSIZE	=120

DB		EQUR		A4

 dcDeclare	A4
 dcAPtr		WBMsg
 dcAPtr		DosBase
 dcAPtr		IntuiBase
 dcAPtr		DWindow
 dcArea		FileInfo,si_SIZEOF
 dcArea		FileBuf,FileBufSIZE
 dcArea		UndoBuf,FileBufSIZE
 dcEnd

Start		DetachSingle	<'ColorCatch'>,4000,0
		dcAlloc					; Allocate memory for variables
		dcReset					; Clear the memory
		lea		FileInfo(DB),A1
		lea		FileBuf(DB),A2
		move.l		A2,si_Buffer(A1)
		lea		UndoBuf(DB),A2
		move.l		A2,si_UndoBuffer(A1)
		move.w		#FileBufSIZE,si_MaxChars(A1)
		lea		FileGad(PC),A2
		move.l		A1,gg_SpecialInfo(A2)

		Prepare		Exec_Call
		suba.l		A1,A1
		CallLib		FindTask
		movea.l		D0,A2
		tst.l		pr_CLI(A2)
		bne.S		GetLibs
		lea		pr_MsgPort(A2),A0
		CallLib		WaitPort
		lea		pr_MsgPort(A2),A0
		CallLib		GetMsg
		move.l		D0,WBMsg(DB)
GetLibs		lea		DosName(PC),A1
		CallLib		OldOpenLibrary
		move.l		D0,DosBase(DB)
		beq.S		Error
		lea		IntuiName(PC),A1
		CallLib		OldOpenLibrary
		move.l		D0,IntuiBase(DB)
		beq.S		Error
		Prepare		Intuition_Call
		lea		NW(PC),A0
		CallLib		OpenWindow
		move.l		D0,DWindow(DB)
		movea.l		D0,A0
		beq.S		Error
		lea		WinTitle(PC),A1
		lea		ScrTitle(PC),A2
		CallLib		SetWindowTitles
		bra.S		Main

Error
Exit
FreeWindow	Prepare		Intuition_Call
		move.l		DWindow(DB),D0
		beq.S		FreeIntui
		movea.l		D0,A0
		CallLib		CloseWindow
FreeIntui	Prepare		Exec_Call
		move.l		IntuiBase(DB),D0
		beq.S		FreeDos
		movea.l		D0,A1
		CallLib		CloseLibrary
FreeDos		move.l		DosBase(DB),D0
		beq.S		ReplyWB
		movea.l		D0,A1
		CallLib		CloseLibrary
ReplyWB		move.l		WBMsg(DB),D2
		beq.S		AllDone
		CallLib		Forbid
		movea.l		D2,A1
		CallLib		ReplyMsg
AllDone		dcFree
		moveq		#0,D0
		rts

Main		Call		GrabColors
EventLoop	Prepare		Exec_Call
		movea.l		DWindow(DB),A0
		movea.l		wd_UserPort(A0),A0
		CallLib		WaitPort
GetNextMsg	Prepare		Exec_Call
		movea.l		DWindow(DB),A0
		movea.l		wd_UserPort(A0),A0
		CallLib		GetMsg
		tst.l		D0
		beq.S		EventLoop
		move.l		D0,A1
		move.l		im_Class(A1),D2
		move.l		im_IAddress(A1),A2
		CallLib		ReplyMsg
		cmp.l		#CLOSEWINDOW,D2
		beq.S		Exit
		cmp.l		#GADGETUP,D2
		beq.S		GJ
		cmp.l		#ACTIVEWINDOW,D2
		bne.S		GetNextMsg
		Call		ActivateFS
		bra.S		GetNextMsg
GJ		move.w		gg_GadgetID(A2),D0	; GadgetID is offset from GJ
		jsr		GJ(PC,D0.W)
		bra.S		GetNextMsg

*»»» The user either activated the window or
*»»» pressed RETURN in the string gadget or
*»»» selected one of the other gadgets in the window.
ActivateFS	Prepare		Intuition_Call
		lea		FileGad(PC),A0
		move.l		DWindow(DB),A1
		suba.l		A2,A2
		CallLib		ActivateGadget
		rts

*»»» The user clicked the 'Grab colors from front screen' gadget
GrabColors	Prepare		Intuition_Call
		move.l		ib_FirstScreen(A6),A0
		move.l		sc_ViewPort+vp_ColorMap(A0),A0
		move.w		cm_Count(A0),D0
		move.l		cm_ColorTable(A0),A0
		lea		ColorCount(PC),A1
		move.w		D0,(A1)+
		bra.S		2$
1$		move.w		(A0)+,(A1)+
2$		dbf		D0,1$
		Call		ActivateFS
		rts

*»»» The user clicked the 'Save with icon' gadget
SaveWith	moveq		#1,D7
		bra.S		SaveColors
*»»» The user clicked the 'Save without icon' gadget
SaveWithout	moveq		#0,D7
SaveColors	Prepare		Dos_Call
		lea		FileBuf(DB),A0
		move.l		A0,D1
		move.l		#MODE_NEWFILE,D2
		CallLib		Open
		move.l		D0,D5
		move.l		D0,D6
		beq.S		FileFailure
		move.l		D6,D1
		lea		ColorExe(PC),A0
		move.l		A0,D2
		move.l		#EndColorExe-ColorExe,D3
		CallLib		Write
		move.l		D0,D5
		move.l		D6,D1
		CallLib		Close
		cmp.l		D5,D3			; Errors during writing ?
		bne.S		FileFailure
		tst.l		D7
		beq.S		AllWritten
		Prepare		Exec_Call		; Make icon too !
		lea		IconName(PC),A1
		CallLib		OldOpenLibrary
		move.l		D0,D6
		beq.S		IconFailure
		lea		FileBuf(DB),A0
		lea		MyDiskObject(PC),A1
		move.l		D6,A6
		CallLib		PutIcon
		move.l		D0,D5
		Prepare		Exec_Call
		move.l		D6,A1
		CallLib		CloseLibrary
		tst.l		D5			; Errors during writing ?
		bne.S		AllWritten
IconFailure	lea		TxtIconFailure(PC),A0
		bra.S		ShowError
FileFailure	lea		TxtFileFailure(PC),A0
ShowError	lea		ITxtAUTOBody(PC),A1
		move.l		A0,it_IText(A1)
		suba.l		A0,A0
		suba.l		A2,A2
		lea		ITxtAUTOOk(PC),A3
		moveq		#0,D0
		moveq		#0,D1
		move.w		#268,D2
		moveq		#46,D3
		Prepare		Intuition_Call
		CallLib		AutoRequest
AllWritten	Call		ActivateFS
		rts

*»»» Write everything between ColorExe and EndColorExe to disk.
*»»» It will become an executable file.
ColorExe	dc.l		$000003F3,$00000000,$00000001,$00000000
		dc.l		$00000000,$0000003B,$000003E9,$0000003B
		dc.l		$7E007C00,$7A002C78,$000493C9,$4EAEFEDA
		dc.l		$24404AAA,$00AC6612,$41EA005C,$4EAEFE80
		dc.l		$41EA005C,$4EAEFE8C,$2E0043FA,$00584EAE
		dc.l		$FE682C00,$672443FA,$005D4EAE,$FE682A00
		dc.l		$67182045,$2068003C,$41E8002C,$303A005A
		dc.l		$43FA0058,$2C464EAE,$FF402C78,$00042005
		dc.l		$67062240,$4EAEFE62,$20066706,$22404EAE
		dc.l		$FE622407,$670A4EAE,$FF7C2242,$4EAEFE86
		dc.l		$70004E75,$67726170,$68696373,$2E6C6962
		dc.l		$72617279,$00696E74,$75697469,$6F6E2E6C
		dc.l		$69627261,$72790000
ColorCount	dc.w		0		; Number of colors in ColorTable
ColorTable	dcb.w		32,0		; Array of colors
		dc.l		$00000000
		dc.w		$03F2
EndColorExe

*»»» Some data »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»

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

IDCMP_Flags	=		GADGETUP|CLOSEWINDOW|ACTIVEWINDOW
Other_Flags	=		NOCAREREFRESH|ACTIVATE|RMBTRAP|WINDOWDEPTH|WINDOWDRAG|WINDOWCLOSE
NW		dc.w		180,50,301,70
		dc.b		0,1
		dc.l		IDCMP_Flags,Other_Flags,GadgetList,0,0,0,0
		dc.w		0,0,0,0,WBENCHSCREEN

GadgetList
FileGad		Gadget		CatchGad,113,18,FW,FH,GADGHCOMP,RELVERIFY,STRGADGET
		Gadget2		FBorder,0,ITxtSaveAs,0,0,ActivateFS-GJ,0
CatchGad	Gadget		WithGad,45,34,CW,CH,GADGHCOMP,RELVERIFY,BOOLGADGET
		Gadget2		CBorder,0,ITxtCatch,0,0,GrabColors-GJ,0
WithGad		Gadget		WithoutGad,12,52,B1W,B1H,GADGHCOMP,RELVERIFY,BOOLGADGET
		Gadget2		B1Border,0,ITxtWith,0,0,SaveWith-GJ,0
WithoutGad	Gadget		0,145,52,B2W,B2H,GADGHCOMP,RELVERIFY,BOOLGADGET
		Gadget2		B2Border,0,ITxtWithout,0,0,SaveWithout-GJ,0

CW		=242
CH		=11
CBorder		Border		-2,-1,1,0,1,9,CVectors,0
CVectors	dc.w		2,0,CW+1,0,CW+3,2,CW+3,CH-1,CW+1,CH+1,2,CH+1,0,CH-1,0,2,2,0
B1W		=120
B1H		=11
B1Border	Border		-2,-1,1,0,1,9,B1Vectors,0
B1Vectors	dc.w		2,0,B1W+1,0,B1W+3,2,B1W+3,B1H-1,B1W+1,B1H+1,2,B1H+1,0,B1H-1,0,2,2,0
B2W		=144
B2H		=11
B2Border	Border		-2,-1,1,0,1,9,B2Vectors,0
B2Vectors	dc.w		2,0,B2W+1,0,B2W+3,2,B2W+3,B2H-1,B2W+1,B2H+1,2,B2H+1,0,B2H-1,0,2,2,0
FW		=172
FH		=9
FBorder		Border		-4,-3,1,0,1,9,FVectors,0
FVectors	dc.w		2,0,FW+5,0,FW+7,2,FW+7,FH+1,FW+5,FH+3,2,FH+3,0,FH+1,0,2,2,0

ITxtCatch	IntuiText	1,0,1,4,2,TxtCatch,0
ITxtSaveAs	IntuiText	1,0,1,-65,0,TxtSaveAs,0
ITxtWith	IntuiText	1,0,1,4,2,TxtWith,0
ITxtWithout	IntuiText	1,0,1,4,2,TxtWithout,0

ITxtAUTOBody	IntuiText	AUTOFRONTPEN,AUTOBACKPEN,AUTODRAWMODE,8,4,0,0
ITxtAUTOOk	IntuiText	AUTOFRONTPEN,AUTOBACKPEN,AUTODRAWMODE,6,3,TxtOk,0

TxtCatch	dc.b		'Grab colors from front screen',0
TxtSaveAs	dc.b		'Save as',0
TxtWith		dc.b		'Save with icon',0
TxtWithout	dc.b		'Save without icon',0

TxtOk		dc.b		' Ok ',0
TxtFileFailure	dc.b		"ColorCatch: Can't create file",0
TxtIconFailure	dc.b		"ColorCatch: Can't create icon",0

ScrTitle	dc.b		'ColorCatch V2.0 1991 by Preben Nielsen',0
WinTitle	dc.b		'ColorCatch V2.0',0

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

TxtAttr		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
		Gadget		0,0,0,60,10,GADGIMAGE|GADGHIMAGE,RELVERIFY|GADGIMMEDIATE,BOOLGADGET
		Gadget2		Image1,Image2,0,0,0,0,0
		dc.b		WBTOOL,0
		dc.l		0,0,100,40,0,0,0

Image1		Image		0,0,60,10,2,Image1Data,3,0,0
Image2		Image		0,0,60,10,2,Image2Data,3,0,0

Image1Data	dc.w		$7FE0,$0FE0,$0000,$0000,$E070,$0C60
		dc.w		$0000,$0000,$C73F,$FC6F,$FFFF,$FFE0
		dc.w		$C7FF,$FC7F,$FE03,$FFE0,$C63F,$FC7F
		dc.w		$FE39,$FFE0,$C7FF,$FC7F,$FE3F,$FFE0
		dc.w		$C73F,$FC7F,$FE31,$FFE0,$E07F,$FE1F
		dc.w		$FE31,$FFE0,$7FFF,$FFFF,$FFF1,$FFC0
		dc.w		$0000,$0000,$0000,$0000
		dc.w		$0000,$0000,$0000,$0000,$1F80,$0380
		dc.w		$0000,$0000,$38C0,$0380,$0000,$0000
		dc.w		$3807,$E383,$F1FC,$3F80,$380E,$3387
		dc.w		$19C6,$7000,$380E,$3387,$19C0,$3F00
		dc.w		$38CE,$3387,$19C0,$0380,$1F87,$E1E3
		dc.w		$F1C0,$7F00,$0000,$0000,$0000,$0000
		dc.w		$0000,$0000,$0000,$0000

Image2Data	dc.w		$7FE0,$0FE0,$0000,$0000,$FFF0,$0FE0
		dc.w		$0000,$0000,$FFFF,$FFEF,$FFFF,$FFE0
		dc.w		$FFF8,$1FFC,$0FFF,$C060,$FE31,$CFF8
		dc.w		$E7FF,$8FE0,$FFF1,$CFF8,$E7FF,$C0E0
		dc.w		$FFF1,$CFF8,$E7F1,$FC60,$FFF8,$1FFC
		dc.w		$0FF1,$80E0,$7FFF,$FFFF,$FFF1,$FFC0
		dc.w		$0000,$0000,$0000,$0000
		dc.w		$0000,$0000,$0000,$0000,$1F80,$0380
		dc.w		$0000,$0000,$38C0,$0380,$0000,$0000
		dc.w		$3807,$E383,$F1FC,$3F80,$380E,$3387
		dc.w		$19C6,$7000,$380E,$3387,$19C0,$3F00
		dc.w		$38CE,$3387,$19C0,$0380,$1F87,$E1E3
		dc.w		$F1C0,$7F00,$0000,$0000,$0000,$0000
		dc.w		$0000,$0000,$0000,$0000
		END