;
; colourPot.s
;
; dbx control for selecting Wimp colours (MDW)
;
;  1995 Straylight
;

;----- Standard header ------------------------------------------------------

		GET	libs:header
		GET	libs:swis

		GET	libs:stream

;----- External dependencies ------------------------------------------------

		GET	sapphire:colourBox
		GET	sapphire:dbox
		GET	sapphire:errorBox
		GET	sapphire:screen
		GET	sapphire:winUtils

		GET	sapphire:dbx.dbx
		GET	sapphire:dbx._dbxMacs

;----- Main code ------------------------------------------------------------

		AREA	|Sapphire$$Code|,CODE,READONLY

; --- colourPot ---
;
; Control data:	+0 == null terminated title string, or empty for default
;		+n
;
; Workspace:	+0 == current colour selected
;		+1
;
; Flags:	bit 8 == allow transparent
;
; Use:		Provides a `colour button' which allows the user to choose
;		a Wimp colour.

		EXPORT	colourPot
colourPot	ROUT

		DBXWS	cp__wSpace
		DCD	dbxMask_click + dbxMask_redraw

		CMP	R0,#dbxEvent_click	;Is this a click event?
		BEQ	%50colourPot		;Yes -- deal with that then

		; --- Redraw a colour pot ---

		STMFD	R13!,{R14}		;Save a register
		LDRB	R14,[R8,#0]		;Load current colour
		CMP	R14,#255		;Is it transparent?
		BEQ	%20colourPot		;Yes -- deal with that then

		; --- Handle shading of icons ---
		;
		; We use the Wimp's shading algorithm from RISC OS 3.5 for
		; this -- clear a bunch of bits!  This is extremely odd,
		; since it doesn't take the lightness/darkness of the colour
		; into account, but it does appear to be standard...

		STMFD	R13!,{R0-R3}		;Save more registers
		ORR	R2,R14,#&80		;Set the `background' bit
		MOV	R0,R10			;Get the dialogue handle
		BL	dbox_window		;Get the window handle
		BL	winUtils_shaded		;Is the icon shaded?
		ANDCS	R2,R2,#&82		;Yes -- oddly clear bits
		MOV	R0,R2			;Get colour in R0
		SWI	Wimp_SetColour		;Set the colour up
		SWI	OS_WriteI+16		;Clear graphics window
		LDMFD	R13!,{R0-R3,PC}^	;And return to caller

		; --- Fill transparent with hatching ---

20colourPot	STMFD	R13!,{R0-R7}		;Save lots of registers
		MOV	R6,R2			;Look after left x coord
		MOV	R7,R3			;And the bottom y coord too

		; --- Work out a colour translation table ---
		;
		; We will shade the pattern sprite if we need to, by using
		; an alternate palette table.

		MOV	R0,R10			;Get the dbox handle
		BL	dbox_window		;Translate to window handle
		BL	winUtils_shaded		;Is the icon shaded?
		MOV	R0,#0			;My sprite is mode 0
		ADRCC	R1,cp__hatchPal		;Point to the palette
		ADRCS	R1,cp__shadePal		;Whichever is appropriate
		MOV	R2,#-1			;Create for current mode
		MOV	R3,#-1			;And the current palette
		MOV	R4,R11			;Build it in the scratchpad
		SWI	ColourTrans_SelectTable	;Build the translate table

		; --- Now set up a zoom block ---

		BL	screen_getInfo		;Read current screen info
		ADD	R14,R0,#screen_dx	;Find current pixel sizes
		LDMIA	R14,{R2,R3}		;Load these out as divisors
		MOV	R0,#2			;Sprite x width is 2
		MOV	R1,#4			;And the y height is 4
		STMFD	R13!,{R0-R3}		;Save these on the stack

		; --- Finally, plot the sprite ---

		MOV	R0,#52			;Plot sprite scaled
		ORR	R0,R0,#(1<<9)		;We have a sprite pointer
		MOV	R1,#&1000		;Use a bogus sprite area
		ADR	R2,cp__hatchSprite	;Point to the sprite data
		MOV	R3,R6			;Recover the x coordinate
		MOV	R4,R7			;And the y coordinate
		MOV	R5,#0			;Just plot the thing
		MOV	R6,R13			;Point to zoom block
		MOV	R7,R11			;And to the translate table
		SWI	OS_SpriteOp		;Plot the sprite
		ADD	R13,R13,#16		;Restore the stack pointer
		LDMFD	R13!,{R0-R7,PC}^	;And return to caller

		; --- Sprite definition ---
		;
		; Here for compactness.

cp__hatchPal	DCD	&FFFFFF00
		DCD	&00000000

cp__shadePal	DCD	&FFFFFF00
		DCD	&BABABA00

cp__hatchSprite	DCD	44+9*4
		DCB	"hatchptn",0,0,0,0
		DCD	0
		DCD	8
		DCD	0
		DCD	17
		DCD	44
		DCD	44
		DCD	0

		DCD	&00030303
		DCD	&0000cccc
		DCD	&00003030
		DCD	&0000cccc
		DCD	&00030303
		DCD	&0000cccc
		DCD	&00003030
		DCD	&0000cccc
		DCD	&00030303

		; --- Handle a mouse click on the button ---

50colourPot	TST	R2,#2			;Is this a menu click?
		BNE	%70colourPot		;Yes -- bring up the dialogue
		TST	R2,#5			;Make sure it's not a drag
		MOVEQS	PC,R14			;If it is, ignore it

		; --- Handle a SELECT or ADJUST click ---

		STMFD	R13!,{R0,R14}		;Save some registers
		LDRB	R0,[R8,#0]		;Load the current colour
		TST	R0,#&F0			;Any top bits set?
		MOVNE	R0,#0			;Yes -- force a wraparound
		BNE	%f00			;And skip on
		TST	R2,#1			;Is this an adjust click?
		RSBNE	R0,R0,#15		;Invert the colour if reqd
		MOV	R0,R0,LSL #28		;Shift into top nibble
		ADDS	R0,R0,#(1<<28)		;Increment the colour
		LDREQ	R14,[R9,#-12]		;Load the flags word
		EOREQ	R14,R14,#(1<<8)		;Complement trans bit
		TSTEQ	R14,#(1<<8)		;Are we allowing transparent?
		MOVEQ	R0,#255			;Yes -- do that then
		MOVNE	R0,R0,LSR #28		;Otherwise shift down again
00		TSTNE	R2,#1			;Was it an adjust click?
		RSBNE	R0,R0,#15		;Yes -- uninvert the colour
		STRB	R0,[R8,#0]		;Save the colour back again
		BL	cp__update		;We've updated the colour
		LDMFD	R13!,{R0,PC}^		;Return to caller

		; --- Handle MENU click --

70colourPot	STMFD	R13!,{R0-R4,R14}	;Save some registers
		STMIA	R12,{R1,R8,R10}		;Save useful information
		LDRB	R0,[R9,#0]		;Load first byte of title
		CMP	R0,#&20			;Is this string empty?
		ADRCC	R0,cp__title		;Yes -- use default string
		MOVCS	R0,R9			;No -- point to user's title
		LDRB	R1,[R8,#0]		;Find the current colour
		LDR	R14,[R9,#-12]		;Load the control's flags
		TST	R14,#(1<<8)		;Does he allow transparent?
		ORRNE	R1,R1,#(1<<8)		;Yes -- then so shall we
		ADR	R2,cp__handler		;Point to my handler
		MOV	R3,#0			;Don't care about R10
		MOV	R4,R12			;Pass workspace in R12
		BL	colourBox		;Try to display the dialogue
		MOVVS	R1,#1			;If it failed, display error
		BLVS	errorBox		;In a one-button errorbox
		LDMFD	R13!,{R0-R4,PC}^	;Return to caller

cp__title	DCB	"cpTITLE",0

		LTORG

; --- cp__handler ---
;
; On entry:	R0 == event code
;		R1 == colour chosen
;
; On exit:	--
;
; Use:		Handles events for our colour box.

cp__handler	ROUT

		CMP	R0,#cbEvent_select	;User made a selection?
		MOVNES	PC,R14			;No -- don't care
		STMFD	R13!,{R1,R8,R10,R14}	;Save some registers
		MOV	R14,R1			;Look after the colour
		LDMIA	R12,{R1,R8,R10}		;Load icon, data, and dbox
		STRB	R14,[R8,#0]		;Save the new colour
		BL	cp__update		;Tell client we've updated
		LDMFD	R13!,{R1,R8,R10,PC}^	;And return to caller

		LTORG

; --- cp__update ---
;
; On entry:	R1 == icon handle
;		R8 == address of control data
;		R10 == dialogue box handle
;
; On exit:	--
;
; Use:		Updates the dialogue box and sends our owner an event.

cp__update	ROUT

		STMFD	R13!,{R0,R2,R14}	;Save some registers
		MOV	R0,R10			;Get the dialogue handle
		BL	dbx_update		;Redraw the control
		MOV	R0,#colourPot_event	;Get the event code
		LDRB	R2,[R8,#0]		;Load the current colour
		BL	dbx_sendEvent		;Send the event off
		LDMFD	R13!,{R0,R2,PC}^	;And return to caller

		LTORG

cp__wSpace	DCD	0

;----- Magic constants ------------------------------------------------------

colourPot_event	EQU	&80000006

;----- Workspace ------------------------------------------------------------

		^	0,R12
cp__wStart	#	0

cp__icon	#	4			;Current control's icon
cp__addr	#	4			;Address of colour byte
cp__dbox	#	4			;Current control's dialogue

cp__wSize	EQU	{VAR}-cp__wStart

		AREA	|Sapphire$$LibData|,CODE,READONLY

		DCD	cp__wSize
		DCD	cp__wSpace
		DCD	0
		DCD	0

;----- That's all, folks ----------------------------------------------------

		END
