;
; dbx.slider.s
;
; Implementation of sliders as a dbx control
;
; © 1994 Straylight
;

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

		GET	libs:header
		GET	libs:swis

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

		GET	sapphire:dbox
		GET	sapphire:divide
		GET	sapphire:idle
		GET	sapphire:win
		GET	sapphire:msgs
		GET	sapphire:screen
		GET	sapphire:winUtils

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

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

		AREA	|Sapphire$$Code|,CODE,READONLY

slFlag_vertical	EQU	(1<<8)
slFlag_horizontal EQU	0
slFlag_colData	EQU	(1<<9)

; --- slider ---
;
; Control data:	+0 == slider colour (if flags bit 9 clear)
;		+1 == background colour
;		+2 == separator colour
;		+3 == reserved
;		+4 == maximum slider value
;		+8
;
; Workspace:	+0 == current slider value
;		+4 == slider colour (if flags bit 9 set)
;		+5 == reserved, must be 0
;		+8
;
; Flags:	Bit 8 == slider is horizontal if clear, vertical is set
;
; Use:		Control type for a slider.

		EXPORT	slider
slider		ROUT

		DBXWS	slider__wSpace
		DCD	dbxMask_click + dbxMask_redraw

		CMP	R0,#0			;Is this a click event?
		BEQ	%50slider		;Yes -- handle it

		; --- Handle a whole slider redraw operation ---

		STMFD	R13!,{R0-R2,R6-R8,R10,R14}

		; --- Get a colour mask ---
		;
		; We use RISC OS 3.5's peculiar shading algorithm -- clear
		; all the colour bits except 1!  This is easy -- we just
		; set up an AND mask in R10 at the start.

		MOV	R0,R10			;Get the dialogue box handle
		BL	dbox_window		;Translate to window handle
		BL	winUtils_shaded		;Is the icon shaded, please?
		MOVCS	R10,#2			;Yes -- leave only bit 1
		MOVCC	R10,#&FF		;Otherwise leave colour alone

		; --- Sort out what needs doing ---

		LDR	R6,[R9,#-12]		;Locate the flags word
		TST	R6,#slFlag_vertical	;Is the slider vertical?
		SUBNE	R7,R5,R3		;Yes -- calculate the height
		SUBEQ	R7,R4,R2		;No -- calculate the width

		; --- Work out the length to draw out ---

		LDR	R0,[R8,#0]		;Load the slider value
		MUL	R0,R7,R0		;Multiply the value up
		LDR	R1,[R9,#4]		;Get the slider maximum val
		BL	div_round		;Calculate correct length
		MOV	R6,R0			;Look after the quotient
		MOV	R7,R2			;Keep the left hand edge
		BEQ	%10slider		;If slider not vert, skip

		; --- Now draw a vertical slider ---

		LDR	R14,[R9,#-12]		;Locate the flags word
		TST	R14,#slFlag_colData	;Is the colour writable?
		LDREQB	R0,[R9,#0]		;Get the slider colour...
		LDRNEB	R0,[R8,#4]		;... from wherever it is
		AND	R0,R0,R10		;Mask colour for shading
		SWI	Wimp_SetColour		;Start in this colour

		BL	screen_getInfo		;Get some screen information
		LDR	R8,[R0,#screen_dy]	;Load the y pixel size

		MOV	R0,#4			;Move absolute coordinates
		MOV	R1,R7			;Left hand side of control
		MOV	R2,R3			;Bottom edge of control
		SWI	OS_Plot			;Move graphics cursor there
		MOV	R0,#&65			;Rectangle fill absolute
		MOV	R1,R4			;Right hand side of control
		ADD	R2,R3,R6		;Top of the slider bar
		SUB	R2,R2,R8		;Allow a bit for the crossbar
		CMP	R2,R3			;Is there any slider bar?
		SWIGE	OS_Plot			;Fill in the slider bar

		LDRB	R0,[R9,#2]		;Get the separator colour
		AND	R0,R0,R10		;Mask colour for shading
		SWI	Wimp_SetColour		;Use this colour now
		MOV	R0,#4			;Move cursor absolute
		ADD	R2,R2,R8		;Top edge of slider bar
		SWI	OS_Plot			;Move the cursor there
		MOV	R0,#5			;Draw line absolute
		MOV	R1,R7			;Left hand side of control
		SWI	OS_Plot			;Fill in the middle bit

		LDRB	R0,[R9,#1]		;Get the background colour
		AND	R0,R0,R10		;Mask colour for shading
		SWI	Wimp_SetColour		;Use this colour now
		MOV	R0,#4			;Move cursor absolute
		ADD	R2,R2,R8		;Top edge of slider bar
		SWI	OS_Plot			;Move the cursor there
		MOV	R0,#&65			;Rectangle fill absolute
		MOV	R1,R4			;Left hand side of control
		CMP	R2,R5			;Is there anything to draw?
		MOV	R2,R5			;Top of the control
		SWILE	OS_Plot			;Fill in the background bit

		B	%90slider		;Skip to the end now

		; --- Now draw a horizontal slider ---

10slider	LDR	R14,[R9,#-12]		;Locate the flags word
		TST	R14,#slFlag_colData	;Is the colour writable?
		LDREQB	R0,[R9,#0]		;Get the slider colour...
		LDRNEB	R0,[R8,#4]		;... from wherever it is
		AND	R0,R0,R10		;Mask colour for shading
		SWI	Wimp_SetColour		;Start in this colour

		BL	screen_getInfo		;Get some screen information
		LDR	R8,[R0,#screen_dx]	;Load the x pixel size

		MOV	R0,#4			;Move absolute coordinates
		MOV	R1,R7			;Left hand side of control
		MOV	R2,R3			;Bottom edge of control
		SWI	OS_Plot			;Move graphics cursor there
		MOV	R0,#&65			;Rectangle fill absolute
		ADD	R1,R7,R6		;Right of the slider bar
		SUB	R1,R1,R8		;Allow for the crossbar
		MOV	R2,R5			;Top edge of the control
		CMP	R1,R7			;Is there anything to draw?
		SWIGE	OS_Plot			;Fill in the slider bar

		LDRB	R0,[R9,#2]		;Get the separator colour
		AND	R0,R0,R10		;Mask colour for shading
		SWI	Wimp_SetColour		;Use this colour now
		MOV	R0,#4			;Move cursor absolute
		ADD	R1,R1,R8		;Top edge of slider bar
		SWI	OS_Plot			;Move the cursor there
		MOV	R0,#5			;Draw line absolute
		MOV	R2,R3			;Bottom edge of the control
		SWI	OS_Plot			;Fill in the middle bit

		LDRB	R0,[R9,#1]		;Get the background colour
		AND	R0,R0,R10		;Mask colour for shading
		SWI	Wimp_SetColour		;Use this colour now
		MOV	R0,#4			;Move cursor absolute
		ADD	R1,R1,R8		;Top edge of slider bar
		SWI	OS_Plot			;Move the cursor there
		MOV	R0,#&65			;Rectangle fill absolute
		CMP	R1,R4			;Is there anything to draw?
		MOV	R1,R4			;Right hand side of control
		MOV	R2,R5			;Top of the control
		SWILE	OS_Plot			;Fill in the background bit

90slider	LDMFD	R13!,{R0-R2,R6-R8,R10,PC}^

		; --- Handle a mouse click event ---
		;
		; We start a slider drag operation

50slider	TST	R2,#5			;Is this a real mouse click?
		MOVEQS	PC,R14			;No -- then ignore it
		STMFD	R13!,{R0-R3,R14}	;Save a few registers

		; --- Save the slider information away ---

		MOV	R0,R10			;Get dialogue handle in R0
		BL	dbx_controlBBox		;Get the control position
		STMIA	R12,{R1-R5,R8,R9}	;Save the state in workspace

		; --- Start a drag operation ---

		SUB	R13,R13,#56		;Make way for a drag block
		MOV	R1,R13			;Point to the block
		SWI	Wimp_GetPointerInfo	;Get the pointer position
		LDR	R7,[R9,#-12]		;Get the control flags
		TST	R7,#slFlag_vertical	;Is the slider vertical?
		LDRNE	R0,[R13,#0]		;Yes -- read mouse x position
		LDREQ	R0,[R13,#4]		;No -- read mouse y position

		MOVNE	R2,R0			;Force mouse to straight line
		MOVNE	R4,R0
		MOVEQ	R3,R0
		MOVEQ	R5,R0

		MOV	R0,R10			;Get the dialogue handle
		BL	dbox_window		;Get the dbox's window handle
		MOV	R1,#7			;Drag type is user-defined
		STMIA	R13,{R0,R1}		;Store them in the block
		ADD	R14,R13,#24		;Point to parent box posn
		STMIA	R14,{R2-R5}		;Save them in the block
		MOV	R1,R13			;Point to the block
		SWI	Wimp_DragBox		;Start a drag operation
		ADD	R13,R13,#56		;Reclaim all that stack space

		ADR	R0,sl__ukEvents		;Point to unknown handler
		MOV	R1,#0			;Don't care about R4
		MOV	R2,R10			;Pass dialogue box in R10
		MOV	R3,R12			;Pass workspace in R12
		BL	win_unknownHandler	;Add the handler
		MOVVC	R0,#2			;Call me every TV frame
		ADRVC	R1,sl__idles		;Point to idle handler
		BLVC	idle_handler		;Add in the idle handler
		BL	sl__idles		;Do one now for luck

60slider	LDMIA	R13!,{R0-R3,R14}	;Load the registers back
		ORRS	PC,R14,#C_flag		;Claim this event

slider__wSpace	DCD	0

		LTORG

; --- sl__idles ---
;
; On entry:	R10 == dialogue box handle for dbox
;		R12 == my workspace
;
; On exit:	--
;
; Use:		Handles idle events during a slider drag

sl__idles	ROUT

		STMFD	R13!,{R0-R5,R8,R9,R14}	;Save a barrelload of regs
		LDMIB	R12,{R2-R5,R8,R9}	;Load registers for readVal
		MOV	R0,#slider_event	;My very own event code
		MOV	R1,#slider_sliding	;Indicate it's still going
		BL	sl__readVal		;Perform the update
		BLCS	dbx_sendEvent		;Send the event if it changed
		LDMFD	R13!,{R0-R5,R8,R9,PC}^	;Return to caller

		LTORG

; --- sl__ukEvents ---
;
; On entry:	R0 == event code
;		R1 == pointer to event data
;		R4 == 0!
;		R10 == dialogue box handle
;		R12 == my workspace
;
; On exit:	If R0 == 7 on entry, C set, otherwise all preserved
;
; Use:		Handles unknown events for sliders.

sl__ukEvents	ROUT

		CMP	R0,#7			;Is this a drag event?
		MOVNES	PC,R14			;No -- not interested then
		STMFD	R13!,{R0-R5,R8,R9,R14}	;Save a bucketload of regs

		; --- Update the slider one last time ---

		LDMIB	R12,{R2-R5,R8,R9}	;Load registers for readVal
		MOV	R0,#slider_event	;My very own event code
		MOV	R1,#slider_slid		;Indicate it's over now
		BL	sl__readVal		;Perform the update
		BL	dbx_sendEvent		;Send the event regardless

		; --- Close down the idle and unknown handlers ---

		ADR	R0,sl__ukEvents		;Point to unknown handler
		MOV	R1,#0			;Don't care about R4
		MOV	R2,R10			;Pass dialogue box in R10
		MOV	R3,R12			;Pass workspace in R12
		BL	win_removeUnknownHandler;Add the handler
		MOV	R0,#2			;Call me every TV frame
		ADR	R1,sl__idles		;Point to idle handler
		BL	idle_removeHandler	;Add in the idle handler

		LDMFD	R13!,{R0-R5,R8,R9,PC}^	;Return to caller at last

		LTORG

; --- sl__readVal ---
;
; On entry:	R0 == event code for dialogue box (slider_event)
;		R1 == subreason code to send (slider_sliding or slider_slid)
;		R2-R5 == position of icon on screen
;		R8 == pointer to control workspace
;		R9 == pointer to control definition
;		R10 == dialogue box handle
;
; On exit:	R2,R3 set up for slider event
;		CS if the slider position has changed
;
; Use:		Reads a slider value from mouse position, and sends the
;		dialogue box an event

sl__readVal	ROUT

		STMFD	R13!,{R0,R1,R6,R14}	;Save some registers

		; --- Read the mouse position ---

		SUB	R13,R13,#20		;Make space for a mouse blk
		MOV	R1,R13			;Point to the block
		SWI	Wimp_GetPointerInfo	;Get the pointer position
		LDR	R14,[R9,#-12]		;Load the control flags
		TST	R14,#slFlag_vertical	;Is the control vertical?
		LDRNE	R0,[R1,#4]		;Yes -- get the y coordinate
		SUBNE	R0,R0,R3		;And chop off bottom posn
		LDREQ	R0,[R1,#0]		;No -- get the x coordinate
		SUBEQ	R0,R0,R2		;And chop of the left posn
		ADD	R13,R13,#20		;Reclaimt the stack now

		; --- Scale this value to user's units ---

		LDR	R6,[R9,#4]		;Get user's maximum value
		MUL	R0,R6,R0		;Multiply position up nicely
		SUBNE	R1,R5,R3		;Vertical -- get height
		SUBEQ	R1,R4,R2		;Horizontal -- get width
		BL	div_round		;Divide and round to nearest
		CMP	R0,R6			;Is the value too large?
		MOVGT	R0,R6			;Yes -- force it down then
		CMP	R0,#0			;Is it too small?
		MOVLT	R0,#0			;Yes -- force it up then
		LDR	R3,[R8,#0]		;Get the old slider value
		CMP	R0,R3			;Is this the same as then?
		STRNE	R0,[R8,#0]		;No -- Store the new value
		MOVNE	R3,R0			;Keep a copy for later

		; --- Update the picture of the slider ---

		MOV	R0,R10			;Get the dialogue handle
		LDR	R1,slider__icon		;Get the icon handle
		BLNE	dbx_update		;Update the slider display

		MOV	R2,R1			;Get icon handle in R2
		LDMFD	R13!,{R0,R1,R6,R14}	;Restore registers
		ORRNES	PC,R14,#C_flag		;If new value, set C on exit
		BICEQS	PC,R14,#C_flag		;Otherwise clear it

		LTORG

;----- Slider event codes ---------------------------------------------------

slider_event	EQU	&80000001
slider_sliding	EQU	0
slider_slid	EQU	1

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

		^	0,R12
slider__wStart	#	0

slider__icon	#	4			;Icon handle for slider
slider__iconPos	#	16			;Icon coordinates on screen
slider__work	#	4			;Pointer to user's workarea
slider__defn	#	4			;Pointer to slider definition

slider__wSize	EQU	{VAR}-slider__wStart

		AREA	|Sapphire$$LibData|,CODE,READONLY

		DCD	slider__wSize
		DCD	slider__wSpace
		DCD	0
		DCD	0

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

		END