rebol [
	Title: "scroll-panel style"
	File: %scroll-panel.r
	Date: 25-Aug-2008
	Version: 1.1.8
	Progress: 0.6
	Status: "working on View 1.3.2" ; "working on View 1.2.10 and View 1.3.1 (1.3.60 and 1.3.61) with small bugs"
	Needs: [View]
	Author: "Anton Rolls"
	Language: 'English
	Purpose: {A panel with scroll-bars for scrolling the contents.}
	Usage: {}
	History: [
		1.0.0 [16-Oct-2003 {First version} "Anton"]
		1.0.1 [21-Oct-2003 {added auto-sizing code from auto-size-panel} "Anton"]
		1.0.2 [23-Oct-2003 {the major bulk done, pretty much fully functional now,
			added scrollers (shown if necessary), feel, resize, 
			added scroll-wheel
		} "Anton"]
		1.0.3 [31-Oct-2003 {moved definition of resize into init so the bind is done only once,
			added calc-size-and-scrollers to unify code common to init and resize} "Anton"]
		1.0.4 [4-Nov-2003 {added resubface for changing the subface} "Anton"]
		1.0.5 [6-Nov-2003 {init: changed auto-size calculation to account for edge,
			resubface now takes the new subface as an argument} "Anton"]
		1.0.6 [29-Nov-2005 {init: changed auto-size calculation to accept -1 in either x or y
			(and if none? size then size is set to -1x-1 first) which fixed the bug which appeared
			at View 1.2.30, when PANEL style's size was changed from none to -1x-1,
			multiplied scroll-wheel by 10 to simulate the line height of a small font (which
			is more what the user expects),
			} "Anton"]
		1.0.7 [30-Nov-2005 {reworked redraw, using code modified from percent-progress.r, which fixed bugs:
			- scroll-bars did not refresh/move when resizing such that no part of the scroller in the old
			  position was still visible.
			Unfortunately, I have used SHOW FACE/PARENT-FACE to make sure there's no junk left behind.
			Fixed bug: scroll-wheel forces vertical scroller to appear, even when it isn't necessary
			} "Anton"]
		1.0.8 [2-Dec-2005 {fixed visual junk when subface was changed by showing face in REDRAW;
			scroller step is now calculated during init and on resize, added key control for arrow keys,
			page-up/down, home & end; DETECT intercepts click on scroll-panel and sets focus (like
			scroll-table)} "Anton"]
		1.0.9 [1-Jun-2006 {set font to none to prevent caret showing up in middle of scroll-panel when it gets
			the focus, therefore also set para to none} "Anton"]
		1.1.0 [8-Aug-2006 {added flag-face self scroll-wheel to init} "Anton"]
		1.1.1 [16-Aug-2006 {add tab key handler to focus back/next-field, added flag-face self tabbed to init,
			showing focused state by changing the edge color, added old-edge-color facet to support this,
			(also tested drawing a box around the border using draw dialect), changed arrow key handling so
			ctrl-arrows move faster (instead of slower), shift-arrows move slower} "Anton"]
		1.1.2 [27-Aug-2006 {added access object and set-scroll-offset function (for focus-system-patch.r),
			resize now also uses set-scroll-offset to recalculate scroller/data for hscroll & vscroll, so that
			scroller/data continues to reflect the subface/offset} "Anton"]
		1.1.3 [29-Aug-2006 {fixed bug updating scrollers using SHOW which of course shows them, but they
			shouldn't be shown when face/show?: false, set crop-box/color: none} "Anton"]
		1.1.4 [10-Sep-2006 {using svvc/focal-highlight instead of hard-coded colour} "Anton"]
		1.1.5 [11-Sep-2006 {set edge: font: para: feel: none in crop-box (a minor optimization), disabled the
			attempt at hardware scrolling for now, as it caused a problem with visual update (see ghost.r)} "Anton"]
		1.1.6 [20-Jan-2007 {improved DETECT down event handler to use FIND-FACE-DEEP (a cut-down version)
			to determine better when to take the focus} "Anton"]
		1.1.7 [29-Jan-2007 {removed DETECT down event handler, ENGAGE now has the simple down event handler,
			added FOCUS-ON-DOWN to flags so this style will work with FOCUS-ON-DOWN-EVENT-HANDLER} "Anton"]
		1.1.8 [25-Aug-2008 {fixed bug: subface wasn't repositioned while resizing, when dragger was away
			from top/left of scroller(s). The subface would jump to the correct offset when any of the scrollers
			disappeared though.
			Moved auto-size code from init into a new function, AUTO-SIZE, extended with new code similar to
			calc-size-and-scrollers, but only tries to *add* space for scrollers. This makes initial layout
			a better fit when max-initial-size is large enough. RESUBFACE now uses the new AUTO-SIZE function} "Anton"]
	]
	ToDo: {
	- FIXED bug: resizing the window makes scroller draggers "creep" towards 0, when they are not at 0 or 1.

	- issue: When clicking on text inside a scroll-panel, the focus may be taken from the scroll-panel by the text,
	  so the scroll-panel will no longer respond to key presses.
	  - perhaps scroll-panel DETECT could check if the focal-face is one of its subfaces,
	    (and perhaps one also specially flagged, eg. [KEY-EVENTS-TO-SCROLL-PANEL] ?),
		then reroute some key events to scroll-panel ENGAGE instead.
		Hmm.. various styles might want to reroute different keys. Eg. one-line TEXTs might want to keep left/right
		for selection purposes but send up/down to scroll-panel.

	- add NO-CARET to flags, maybe it will speed up rendering a tiny bit.
	
	- add helper functions "offset-to-scroller-data", "scroller-data-to-offset" to support access/set-scroll-offset ?
	
	- remove the down event handler altogether (don't really need it since scroll-wheel-handler) ?

	- Base on FACE instead of PANEL. As I learned from the auto-size bug around View 1.2.29-30,
	  it's safer to base scroll-panel on FACE than base on PANEL, which is more fragile.
	  (This should also make porting to RebGUI easier.)
	  - check exactly what is inherited from PANEL and IMAGE
	  - but VID functions may expect VID facets to be there, and basing on face loses some VID functionalities
	    - but the meaning of "FACE" above is probably actually VID-FACE
	- check out problem shown in debug-scroll-panel.r:
	  edges of faces inside the scroll-panel, with a merge luma effect, are keeping old background appearance
	- check out the new REFOCUS function again and see what implications it has with focusing
	- inner panel background broken since View beta 1.2.19 (probably just image! datatype teething problems)
	- access functions
	- doc object
	- move functions directly in the face into feel or access object
	- changing subface
	  - init is blanked after it is done the first time, so need to move init functions to a new facet.
	    or advise user to use layout/keep refinement
	- might not need crop-box, subface can be in the pane directly (scroll-panel/pane/subface)
	- show focused state 
	  - DONE: by edge color (only if present)
	  - or use draw dialect to draw a box around the border ?
	    - to be reliably overlaid a full-sized transparent face would have to be added to the pane, and this would
	      probably slow down rendering significantly
	      - but four "edge" faces could be used to draw the lines (probably much faster, but more complex system...)
	    - in practice, a non-overlaid drawing should be visible most of the time, because most layouts
	      specify at least some gap at the borders... (actually, the crop-box face will usually block most of it,
	      unless its default offset is changed from 0x0, as I discovered in style-gallery.r)
	- Looks FIXED: when scrollers disappear and crop-box doesn't cover the entire area, the
	  scroll-panel's background doesn't refresh over the scrollers (ie. scroller rubbish is left)
	- test the hardware scrolling, make a separate testing file for this
	  - seems to require SHOWing the specific face whose changes facet has been set (and not its parent-face, for instance)

	  This is OK (showed ghost face):
	  
						show crop-box
						
	  and this is OK:
	  
						crop-box/pane/changes: [offset] ; attempt hardware accelerated scrolling
						show crop-box/pane ; <- the changes facet is only cleared when the specific face is shown
						show crop-box

	  But this is not OK:
	  	  
						crop-box/pane/changes: [offset] ; attempt hardware accelerated scrolling
						show crop-box/pane ; <- the changes facet is only cleared when the specific face is shown
						show crop-box
	  	  
	- a subface that is complex, such as with backdrop [gradcol] slows down the refresh a lot
	  Can I do something about this?
	- unfocus on down action ? (directly in feel/engage, action block used for layout spec)
	}
	Notes: {
		Simply focusing the scroll-panel on down event in DETECT had the problem that the focus
		changes rapidly to each nested scroll-panel, giving a flickering focus change.
		Moving that code into ENGAGE down event handler however is not the solution, because then the
		event is not picked up. The current solution is:
		
		A global handler finds the deepest face, then bubbles up to find the first focusable (FOCUS-ON-DOWN) face.
	  
		Ancestry is:  face -> IMAGE -> PANEL -> scroll-panel

		do util/compare-objects.r
		compare-objects face svv/vid-styles/panel
		Common facets that are different: [color edge effect feel font size]

		I didn't see a way to use effect dialect 'crop to crop the crop-box's pane.
		
		Need the key focus to catch scroll-wheel events.
		Scroll-wheel doesn't work on inner scroll-panel (because not the focal-face).
		(Both solved by using scroll-wheel-handler.)

		[This binding looks not necessary:- since LAYOUT was modified to bind init for us ? but that's before View 1.2.1 ...]
		Note that the technique of binding new function code, during init, to the new 
		scroll-panel face; consumes more memory when using multiple scroll-panels,
		because the code is duplicated, but reads better because all the paths need not
		start with "face/" (already bound to face), so that means less code as well and
		it might be a tiny bit faster since all those paths need one less evaluation step,
		and there's no need to pass the face argument to the function.
		(It might be good to write a more memory efficient version later. I don't think
		it's significant now, though.)

		ISOLATED weird bugs: with View 1.3.60 and 61 (regardless of anton-user), page-up key -> "clipboard", 
		page-down -> "object", and home end keys give other weird results.
		Problem is in those versions of Rebol/View:
		  view layout [b: box feel [engage: func [face action event][if action = 'key [print event/key]]] do [focus b]]
		
		face/changes: [offset] ; flag hardware accelerated scrolling

		Face hierarchy:
		
		   scroll-panel
		    /    |   \
		   /     |    \
		  /      |     \
	  crop-box  hscroll vscroll
	     |
		 |
	  subface

		Ancestry:
		
			panel -> scroll-panel
			scroller -> hscroll, vscroll
			box -> crop-box
			(result of LAYOUT) vid-face -> subface
		
	}
	Public-Functions: [scroll-panel-style]
]

context [ ; required by include framework

scroll-panel-style: stylize [
	scroll-panel: panel with [

		flags: [tabbed scroll-wheel focus-on-down]
		; TABBED: this face participates in tab-key focus cycling
		; SCROLL-WHEEL: scroll-wheel-handler, if installed, will see this and send scroll-wheel events to feel/engage
		; FOCUS-ON-DOWN: focus-on-down-event-handler, if installed, will see this and when a subface is clicked 
		;     and is not focused afterwards (by the click), then bubbles up through parent faces to find one which
		;     has the FOCUS-ON-DOWN flag and focuses it.

		font: none ; <- setting font to none prevents the caret appearing when we have the focus
		para: none
		;;effect: [draw [pen none box 0x0 10x10]] ; key focus box
		
		subface: none
		crop-box: none
		hscroll: none
		vscroll: none
		hscroll?: none
		vscroll?: none
		max-initial-size: none
		scroller-width: 16
		old-edge-color: none ; remember colour before changing to key focus colour

		calc-size-and-scrollers: none
		resize: none
		old-size: none
		old-subface: none
		resubface: none

        words: compose [
			max-initial-size [new/max-initial-size: second args next args]
			subface [new/subface: second args next args] ; should be block! or face
			scroller-width [new/scroller-width: second args next args]
		]

		access: make access [
			set-scroll-offset: func ["Sets the scroll position (subface/offset) and updates the scroller drag-bars to reflect the new position."
				face offset [pair!]
				/no-show
				/local scrolldom
			][
				face/subface/offset: offset
				; fix the scroll-bar positions, guarding against division by zero
				scrolldom: max 0x0 (face/subface/size - face/crop-box/size) ; total - visible
				face/hscroll/data: either scrolldom/x > 0 [- face/subface/offset/x / scrolldom/x][0]
				face/vscroll/data: either scrolldom/y > 0 [- face/subface/offset/y / scrolldom/y][0]
				if not no-show [show face]
			]
		]
		
		feel: make get in get-style 'image 'feel [
			redraw: func [face action position][
				
				; OLD code
				;if action = 'draw [
				;	if face/subface <> face/crop-box/pane [
				;		face/resubface face/subface
				;	]
				;	if (face/size) <> face/old-size [
				;		face/resize
				;		face/old-size: face/size
				;	]
				;]

				; NEW
				if action = 'show [
					if face/subface <> face/crop-box/pane [
						face/resubface face/subface
						show face
					]
					if face/size <> face/old-size [
						face/resize
						face/old-size: face/size
						show face/parent-face ; showing parent-face to clean trails in parent-face (not affected by crop-box/pane/changes: [offset])
					]
				]

				; NEW (modified from percent-progress.r)
				; (I verified that face/state is safe to use. It was only used in default panel style's init.)
				;if action = 'show [
				;	if face/subface <> face/crop-box/pane [
				;		face/resubface face/subface
				;		show face/parent-face
				;	]
				;	if face/state <> reduce [face/size][
				;		face/resize
				;		face/state: reduce [face/size]
				;		show face/parent-face ; <-- this recurses, so make sure do this after updating face/state
				;	]
				;]
				
				if all [ ; key focus box
					face/edge any [face/edge/size/x > 0 face/edge/size/y > 0]
				][
					if none? face/old-edge-color [face/old-edge-color: face/edge/color] ; store original colour
					;;face/edge/color: either face = system/view/focal-face [0.50.190][face/old-edge-color] ; <- hard-coded color
					face/edge/color: either face = system/view/focal-face [
						any [all [in svvc 'focal-highlight svvc/focal-highlight] 0.50.190] ; fall back to hard-coded colour
					][face/old-edge-color]
				]
				
				;face/effect/draw/2: if face = system/view/focal-face [ ; key focus box
				;	face/effect/draw/4: 2x2
				;	face/effect/draw/5: face/size - 3x3 - any [all [face/edge face/edge/size * 2] 0x0]
				;	0.50.190 ; <- hard-coded color (else NONE)
				;]
			]
			detect: func [face event][
				;if all [event/type = 'down rebol/view/focal-face <> face][

					;;focus face  ; allows scrollwheel and key control
									
					; Determine if this scroll-panel, or one of its direct subfaces, is the face under the mouse offset.
					; ie. not faces contained in the crop-box.
					
					;if find back back tail (find-face-deep face event/offset) face [
					;
					;	focus face  ; allows scrollwheel and key control
					;	return none ; eat the event
					;]
				;]
				event
			]
			engage: func [face action event /local hscroll vscroll amount][
				if all [event/type = 'down rebol/view/focal-face <> face][
					focus face  ; allows scrollwheel and key control
				]
				if event/type = 'scroll-line [ ; catch scroll-wheel events
					vscroll: face/vscroll
					if vscroll/show? [ ; stop the scroll-wheel showing the scroller when it isn't visible (ie. not needed)
						vscroll/data: min max vscroll/data + (vscroll/step * event/offset/y * 10) 0 1  ; * 10 to simulate the line-height of a small font 
						vscroll/action vscroll vscroll/data
						show vscroll
					]
				]
				if action = 'key [
					;probe event/key
					vscroll: face/vscroll
					hscroll: face/hscroll
					amount: case [event/control [100] event/shift [1] true [10]]
					switch event/key [
						left  [scroll hscroll hscroll/step * - amount]
						right [scroll hscroll hscroll/step * amount]
						up    [scroll vscroll vscroll/step * - amount]
						down  [scroll vscroll vscroll/step * amount]
						home [scroll hscroll -1]
						end  [scroll hscroll 1]
						page-up   [scroll vscroll -1 * vscroll/page]
						page-down [scroll vscroll 1 * vscroll/page]
						#"^-" [focus either event/shift [ctx-text/back-field face][ctx-text/next-field face]]
					]
				]
				event
			]
			scroll: func ["moves the current scroll position using one of the scrollers"
				scroller [object!] "vscroll or hscroll face"
				offset [number!] "change to scroller/data"
			][
				if scroller/show? [ ; don't bother if it's not visible (ie. not needed)
					scroller/data: min max scroller/data + (offset) 0 1
					scroller/action scroller scroller/data
					show scroller
				]
			]
		]

		auto-size: has [orig-size][
			; NEW auto-size code (backwards compatible to 1.2.29 and before, and up to 1.3.61 and beyond)
			;  (PANEL/size changed from NONE to -1x-1 in View 1.2.30)
			if none? size [size: -1x-1] ; auto-size width and height
			orig-size: size
			if size/x < 0 [
				;print "auto-size x"
				size/x: subface/size/x
				if all [edge edge/size][size/x: size/x + (edge/size/x * 2)]
				if max-initial-size [size/x: min size/x max-initial-size/x]
			]
			if size/y < 0 [
				;print "auto-size y"
				size/y: subface/size/y
				if all [edge edge/size][size/y: size/y + (edge/size/y * 2)]
				if max-initial-size [size/y: min size/y max-initial-size/y]
			]

			; ...continue with auto-size
			; Do similar to calc-size-and-scrollers, except try to *add* space for scrollers (not always subtract).
			;  (This adding should only happen with auto-sizing, probably only ever during init).
			crop-box/size: size - any [all [edge edge/size 2 * edge/size] 0x0] ; size minus space taken by edge
			if all [
				hscroll?: crop-box/size/x < subface/size/x
				orig-size/y < 0 ; auto-sizing y
			][
				size/y: size/y + scroller-width ; Add space for horizontal scroller
				if max-initial-size [size/y: min size/y max-initial-size/y] ; limit again
				crop-box/size/y: size/y - any [all [edge edge/size 2 * edge/size/y] 0] ; recalc crop-box height
			]
			if all [
				vscroll?: crop-box/size/y < subface/size/y
				orig-size/x < 0 ; auto-sizing x
			][
				size/x: size/x + scroller-width ; Add space for vertical scroller
				if max-initial-size [size/x: min size/x max-initial-size/x] ; limit again
				crop-box/size/x: size/x - any [all [edge edge/size 2 * edge/size/x] 0] ; recalc crop-box width
			]
			if not hscroll? [
				; adding the vertical scroller might make the horizontal scroller necessary
				if all [
					hscroll?: crop-box/size/x < subface/size/x
					orig-size/y < 0 ; auto-sizing y
				][
					size/y: size/y + scroller-width ; Add space for horizontal scroller
					if max-initial-size [size/y: min size/y max-initial-size/y] ; limit again
					crop-box/size/y: size/y - any [all [edge edge/size 2 * edge/size/y] 0] ; recalc crop-box height
				]
			]
			if hscroll [hscroll/show?: hscroll?]
			if vscroll [vscroll/show?: vscroll?]
			;old-size: size
		]
		
		init: [;print 'init
			if image? image [
				if size/y < 0 [ ; only width was specified
					size/y: size/x * image/size/y / image/size/x ; calculate width with correct aspect
					effect: insert copy effect 'fit
				]
				if color [effect: join effect ['merge 'colorize color]]
			]

			if none? subface [subface: []]
			if block? subface [
				subface: layout/styles/offset subface copy self/styles 0x0
			]

			crop-box: make-face/spec 'box [
				offset: 0x0
				pane: subface
				color: edge: font: para: feel: none ; <--- new
			]

			auto-size
			
			calc-size-and-scrollers: does bind [
				;calculate crop-box size and whether scrollers necessary
				crop-box/size: size

				; remove space taken by edge
				if all [edge edge/size][crop-box/size: crop-box/size - (2 * edge/size)]

				; determine if scrollers are necessary to be shown
				; subtract here space taken by scrollers, if necessary
				if hscroll?: crop-box/size/x < subface/size/x [crop-box/size/y: crop-box/size/y - scroller-width]
				if vscroll?: crop-box/size/y < subface/size/y [crop-box/size/x: crop-box/size/x - scroller-width]
				if not hscroll? [
					; adding the vertical scroller might make the horizontal scroller necessary
					if hscroll?: crop-box/size/x < subface/size/x [
						crop-box/size/y: crop-box/size/y - scroller-width
					]
				]
				if hscroll [hscroll/show?: hscroll?]
				if vscroll [vscroll/show?: vscroll?]
				old-size: size
			] in self 'self

			pane: reduce [
				crop-box
				hscroll: make-face/spec 'scroller compose [ ; scroller action
					offset: (0x1 * crop-box/size)
					size: (crop-box/size * 1x0 + (0x1 * scroller-width))
					show?: hscroll?
					ratio: crop-box/size/x / subface/size/x
					action: func [face value /local crop-box][
						crop-box: face/parent-face/crop-box
						crop-box/pane/offset/x: 0 - to-integer (subface/size/x - crop-box/size/x * value)
						;crop-box/pane/changes: [offset] ; attempt hardware accelerated scrolling
						;show crop-box/pane ; <- the changes facet is only cleared when the specific face is shown
						show crop-box
					]
					; step = 1 / (total - visible)
					use [x][
						x: max 0 (subface/size/x - crop-box/size/x)
						step: either 0 = x [1][1 / x] ; prevent division by zero
					]
				]
				vscroll: make-face/spec 'scroller compose [ ; scroller action
					offset: (1x0 * crop-box/size)
					size: (crop-box/size * 0x1 + (1x0 * scroller-width)) 
					show?: vscroll?
					ratio: crop-box/size/y / subface/size/y
					action: func [face value /local crop-box][
						crop-box: face/parent-face/crop-box
						crop-box/pane/offset/y: 0 - to-integer (subface/size/y - crop-box/size/y * value)
						;crop-box/pane/changes: [offset] ; attempt hardware accelerated scrolling
						;show crop-box/pane ; <- the changes facet is only cleared when the specific face is shown
						show crop-box
					]
					; step = 1 / (total - visible)
					use [y][
						y: max 0 (subface/size/y - crop-box/size/y)
						step: either 0 = y [1][1 / y] ; prevent division by zero
					]
				]
			]

			resubface: func ["sets the subface and refreshes" new "your new subface" [block! object!]] bind [;print 'resubface
				subface: new
				if block? subface [
					subface: layout/offset subface 0x0
				]
				crop-box/pane: subface
				
				;;if none? size [
				;;	; auto-size
				;;	size: subface/size
				;;	if all [edge edge/size][size: size + (edge/size * 2)]
				;;	if max-initial-size [size: min size max-initial-size]
				;;]
				auto-size

				if block? pane [pane/1: crop-box]
				resize
				;show self ; <-- this SHOW would recurse when resubface is called from REDRAW
			] in self 'self

			resize: has [x y] bind [
				calc-size-and-scrollers

				if hscroll/show?: hscroll? [
					hscroll/offset: 0x1 * crop-box/size
					hscroll/ratio: crop-box/size/x / subface/size/x
					hscroll/resize hscroll/size: crop-box/size * 1x0 + (0x1 * scroller-width)

					; step = 1 / (total - visible)
					x: max 0 (subface/size/x - crop-box/size/x)
					hscroll/step: either 0 = x [1][1 / x] ; prevent division by zero
				]

				if vscroll/show?: vscroll? [
					vscroll/offset: 1x0 * crop-box/size
					vscroll/ratio: crop-box/size/y / subface/size/y
					vscroll/resize vscroll/size: crop-box/size * 0x1 + (1x0 * scroller-width)

					; step = 1 / (total - visible)
					y: max 0 (subface/size/y - crop-box/size/y)
					vscroll/step: either 0 = y [1][1 / y] ; prevent division by zero
				]
				subface/offset/x: 0 - to-integer (hscroll/data * max 0 (subface/size/x - crop-box/size/x))
				subface/offset/y: 0 - to-integer (vscroll/data * max 0 (subface/size/y - crop-box/size/y))
				;access/set-scroll-offset/no-show self subface/offset

			] in self 'self
		]
	]
]

] ; end of context