rebol [
	Title: "focus system patch"
	File: %focus-system-patch.r
	Date: 17-Jan-2008
	Version: 1.0.9
	Progress: 0.6
	Status: "working, tested on View 1.3.2.3.1"
	Needs: [View]
	Author: "Anton Rolls"
	Language: "English"
	Purpose: {Patch FOCUS and UNFOCUS to allow a new focus-action to override the default functionality, 
		and implement the NO-CARET face-flag to allow faces to receive key events without having the system
		caret involved}
	Usage: {see gui/style-gallery.r}
	History: [
		1.0.0 [15-Apr-2005 {First version} "Anton"]
		1.0.1 [20-Aug-2006 {added no-caret face-flag, which stops FOCUS from modifying face/text or setting caret,
			wrapped in context for include, added no-caret-key-handler, tested successfully with rotate-knob in
			style-gallery.r} "Anton"]
		1.0.2 [27-Aug-2006 {added scroll-to-face (functionality moved from gui/tab-key-handler.r)} "Anton"]
		1.0.3 [29-Aug-2006 {added /SCROLL and /ANIMATE refinements to FOCUS} "Anton"]
		1.0.4 [30-Aug-2006 {made animated scroll interruptable by a new scroll, by removing the old handler early
			} "Anton"]
		1.0.5 [23-Oct-2006 {modified focus and unfocus to only show when face/show? = true} "Anton"]
		1.0.6 [4-Feb-2007 {animated scroll accelerates & decelerates} "Anton"]
		1.0.7 [14-Mar-2007 {removed relic code in SCROLL-TO-FACE which tried to RETURN EVENT,
			SCROLL-TO-FACE's FACE argument now must be an object!} "Anton"]
		1.0.8 [17-May-2007 {renamed local F to CLIMBER, SCROLL-TO-FACE now also accepts a paren! FACE argument} "Anton"]
		1.0.9 [17-Jan-2008 {passing through /no-show in focus-action} "Anton"]
	]
	ToDo: {
	- no-caret-key-handler should also send event to DETECT
	
	- focal history
	  - UNFOCUS could have a refinement to refocus the prior focal-face after unfocusing the current one
	    - maybe current UNFOCUS should be called "DEFOCUS" and UNFOCUS refocuses the prior focal face
	
	- scroll-to-face: only show when face/show? = true
	
	- scroll-to-face should take caret into consideration (user wants to see caret) (when not a no-caret face)

	- smooth scroll, use acceleration/deceleration as target offset is approached

	  - insert a handler function to process the time events and remove itself afterwards
	    - start time events
	      - (for minimal impact) add an invisible face (setting its RATE) to one of the scroll-panels temporarily
	      - by setting window/rate ?
	        - only if it is currently NONE
	        - leave the rate as is after the animation has completed
	    - measure the time since start-time and this event/time to calculate where the animation should be up to.
	    - variables needed:
	      - start-time (Derived from the first event/time ?)
	      - event/time
	      - progress position (I used to call it PC). Value between 0.0 and 1.0. (Derived from event/time - start-time.)
	      - progress offset (Derived from progress position)

	  - nested scroll-panels: 
	    - OR determine target for each scroll-panel first, then set animation in motion <-- I prefer this
	    - maybe each scroll-panel can take responsibility for its own animation
	      - so RATE is set for each scroll-panel (not touching window)

	  - collect all the old,new offsets for each scroll-panel, so we have a block like this to process:
	    [
	    	scroll-panel-1 old new 
	    	scroll-panel-2 old new 
	    	...
	    ]
	    
	  - build handler function
	  
	  - insert handler function
	  
	  - start time events  <---- Currently this is done by setting the RATE of the outermost scroll-panel
	    but the time events are flowing in at top speed into the event-handler (being at top level).
	    However, it looks as if time events do not stack up when they are handled slowly and event/time seems
	    accurate to when the event itself is handled. (So that's good.)
	      - Maybe to be sure use  difference now/precise start-time  instead ?
	      - see doc/time-event-flow.r
	  
	  - change focal-face from old to new 
	    - at the beginning
	    - OR when the animation is almost finished (some minimum distance) ?
	    - OR at the end ?
	    - OR when the new face becomes partially visible ?
	
    - create a standard way to determine if a face is scrollable ? 
      Currently just checking if face/style = 'scroll-panel
      - use a face-flag ?

    - Tabbing to a face that is only partially or not visible in a scroll-panel scrolls to it.
	  Algorithm:
	    - start at the newly tabbed face
	    - travel up the face hierarchy, checking each parent face to see if the tabbed face is within it (ie. visible).
	    - when a parent face is found that does not fully enclose the tabbed face, it is noted, and:
	    - check if that parent face is a scrollable face (ie. a scroll-panel)(can't just go changing any face's offset).
	      - if so, fix the offset by the least amount so the newly tabbed face is totally (if possible) visible
	        - start travelling up the hierarchy again, beginning once again from the newly tabbed face
	    - continue until the window is reached and no more can be done
	    
	  - This affects SCROLL-PANEL, image-editor, zoom-image, 
	    Any others ? (scroll-table and shell-list ? It's quite possible a scroll-table could contain a tabbable face, 
	    scrolled out of view.) group-box and title-panel (if they become scrollable)
	    
	- check out Romano's and other people's focus systems for other abilities I might have missed
	- see the ON-UNFOCUS face-flag already in the system:
	
		  print mold system/view/screen-face/feel/event-funcs
		  
	- (see also the older gui/focus-action.r)
	}
	Notes: {
		The idea is that a style can completely change the behaviour of FOCUS and UNFOCUS
		by makeing face/feel/focus-action and unfocus-action functions.
		These words ('focus-action and 'unfocus-action) do not need to be present in the feel,
		so the system is backward compatible with styles which do not have the words in their
		feels (like all the current styles). However, once they are present and defined as
		functions, then the style can completely disable or replace all of the functionality
		of the FOCUS and UNFOCUS functions.

		The no-caret-key-handler is there to allow faces which want key events but don't want
		the caret visible.

		focus/scroll only works after layout. eg. this should focus but not scroll to the field:
		
			layout [scroll-panel [ field with [focus/scroll self] ]]
		
		Taking edges into account.
	
		  window/edge/size = 0x0  
		  This is correct and consistent, because the window/offset actually points to the origin for the window/pane,
		  not the actual top-left of the window as you might expect.
	
		  system/view/screen-face/edge/size = 2x2
		  This is inconsistent, it should be 0x0
	    
		REBOL/View 1.2.57.3.1 8-Dec-2004

		; original
		focus: func [
			"Focuses key events on a specific face."
			face
			/no-show
			/local tmp-face
		][
			unfocus
			if not face [exit]
			focal-face: face
			if not string? face/text [
				face/text: either face/text [form face/text] [copy ""]
				face/line-list: none
			]
			if not caret [caret: tail face/text]
			if none? face/line-list [
				if face/para [face/para/scroll: 0x0]
				caret: tail face/text
			]
			if flag-face? face field [hilight-all face]
			if not no-show [show face]
		]

		; original
		unfocus: func [
			"Removes the current key event focus."
			/local tmp-face
		][
			tmp-face: focal-face
			focal-face: none
			caret: none
			unlight-text
			if tmp-face [show tmp-face]
		]
	}
	Public-Functions: [focus unfocus no-caret-key-handler scroll-to-face]
]

context [

	focus: func [
	    "Focuses key events on a specific face. Patched by Anton." ; <- style-gallery.r looks for "patch" in this string.
	    face
	    /scroll "scrolls to the focused face" ; <-- new line
	    /animate "animates the scroll" ; <-- new line
	    /no-show
	    /local tmp-face
	] bind [
		either all [ ; is there a focus-action ?
			face face/feel 
			in face/feel 'focus-action
			get in face/feel 'focus-action
		][
			;face/feel/focus-action face ; do the focus-action
			; do the focus-action, passing through refinement no-show
			;do reduce [append copy 'face/feel/focus-action either no-show ['no-show][[]]] 'face]
			; do the focus-action, passing through refinements no-show, scroll, animate
			do reduce [append copy 'face/feel/focus-action remove-each ref copy [no-show scroll animate][not get ref] 'face]
		][
			; else do the old behaviour (modified to implement the no-caret face-flag, and also check face/show?)
		    unfocus
			if not face [exit]
			focal-face: face
			;if not string? face/text [ ; <-- old line
			if all [not string? face/text not flag-face? face no-caret][ ; <-- new line
				face/text: either face/text [form face/text] [copy ""]
				face/line-list: none
			]
			;if not caret [caret: tail face/text] ; <-- old line
			if all [not caret not flag-face? face no-caret][caret: tail face/text] ; <-- new line
			;if none? face/line-list [ ; <-- old line
			if all [none? face/line-list not flag-face? face no-caret][ ; <-- new line
				if face/para [face/para/scroll: 0x0]
				caret: tail face/text
			]
			if flag-face? face field [hilight-all face]
			if all [face scroll][either animate [scroll-to-face/animate face][scroll-to-face face]] ; <-- new line
			;if not no-show [show face]
			if all [not no-show face/show?][show face]
		]
	] system/view
	
	; patched
	unfocus: func [
	    "Removes the current key event focus. Patched by Anton." ; <- style-gallery.r looks for "patch" in this string.
	    /local tmp-face
	] bind [
		either all [ ; is there an unfocus-action ?
			focal-face focal-face/feel 
			in focal-face/feel 'unfocus-action
			get in focal-face/feel 'unfocus-action
		][
			focal-face/feel/unfocus-action focal-face ; do the unfocus-action
			;do pick [focal-face/feel/unfocus-action/no-show focal-face/feel/unfocus-action] no-show focal-face ; do the unfocus-action, passing through no-show
		][
			; else do the old behaviour (modified to check face/show?)
			tmp-face: focal-face
			focal-face: none
			caret: none
			unlight-text
			;if tmp-face [show tmp-face]
			if all [tmp-face tmp-face/show?][show tmp-face]
		]
	] system/view

	no-caret-key-handler: func [face event][
		if all [
			event/type = 'key 
			system/view/focal-face  ; there is a focal-face
			none? system/view/caret ; but there is no caret
			; the View system (DO EVENT) won't send the key events if there's no caret so we do it 
			flag-face? system/view/focal-face no-caret ; only for faces flagged with NO-CARET.
			system/view/focal-face/feel ; and which have a FEEL/ENGAGE function
			get in system/view/focal-face/feel 'engage 
		][
			; <- send to detect first (and check the return value) ?  (like mimic-do-event...?)
			;  because the face might be expecting all events to go through detect first.
			system/view/focal-face/feel/engage system/view/focal-face event/type event
			return none ; swallow this event
		]
		event ; allow other events to continue
	]
	
	ctx-anim: none ; just to be able to remove the last animator function
	
	scroll-to-face: func ["Scroll any scroll-panels so FACE becomes visible."
		face [object! paren!]
		/animate "animate between old and new offset"
		/local screen-face climber offset parent edge-size edges scroll-panel pos opp new old animations animator
	][
		;print "------"
  		; If FACE is visible in all faces up to, but not in, the crop-box of a scroll-panel,
  		; then fix the subface scroll offset (if possible, if not possible then break here).
  		; Do that again until the window is reached (ie. no more scroll-panels).
  		; (OR adjust the variables appropriately and continue up the face hierarchy).
  		
  		face: do face ; DO in case FACE is a wrapped pane function
  		;print ["scroll-to-face" face/offset any [all [in face 'style face/style] ""] face/size]
		climber: face ; CLIMBER climbs up the face hierarchy, starting at FACE
  		screen-face: system/view/screen-face
  		offset: face/offset ; offset accumulates the offset and edges of climber/parent-face as CLIMBER climbs up the face hierarchy
  		animations: copy []
  		while [
  			parent: any [climber/parent-face screen-face]
  		][
  			;print ["consider at" climber/offset tab climber/size tab climber/style]
  			edge-size: any [all [parent/edge parent/edge/size] 0x0]
  			
  			; screen-face edge should not be counted
  			if parent = screen-face [edge-size: edge-size - screen-face/edge/size]
  			
  			edges: 2 * edge-size ; both edges
  			
  			if not all [ ; not visible up to here (inside parent) ?
  				within? offset 0x0 parent/size - edges
  				within? offset + face/size - 1x1 0x0 parent/size - edges
			][
				;print "not visible"
				either all [
			  		; is parent/parent-face a scroll-panel ?
					scroll-panel: parent/parent-face ; there is a parent-face
					parent/parent-face/style = 'scroll-panel ; and it is a scroll-panel
					; therefore parent is the crop-box of the scroll-panel, and CLIMBER is the subface
				][
					;print "scroll"

					; determine how much to scroll the subface to make FACE visible and do it
					; (<- scroll as much as possible towards the face)
										
					subface: climber
					crop-box: parent
					
					pos: offset - subface/offset ; offset of FACE relative to subface
					opp: pos + face/size ; bottom-right (opposite) corner of FACE
					
					new: old: subface/offset ; (NEW will later become the new subface/offset)
					
					; (top left is favoured over bottom right)
					if opp/y + new/y > crop-box/size/y [ ; below the bottom of the crop-box ?
						new/y: crop-box/size/y - opp/y
					]
					if pos/y + new/y < 0 [ ; above the top of the crop-box ?
						new/y: - pos/y
					]
					if opp/x + new/x > crop-box/size/x [ ; to the right ?
						new/x: crop-box/size/x - opp/x
					]					
					if pos/x + new/x < 0 [ ; to the left ?
						new/x: - pos/x
					]
					
					; when modifying subface/offset here, also need to correct OFFSET by the same amount
					offset: offset + (new - old)

					either animate [
						; collect scroll-panel old new
						insert animations reduce [scroll-panel old new]
					][				
						;;subface/offset: new
						scroll-panel/access/set-scroll-offset scroll-panel new
					]
					
					show parent/parent-face
					;if scroll-panel/show? [show scroll-panel] ; <- not necessary (?) "Scroll ... so FACE becomes visible."
				][
					;print "can't do anything"
					;break
				]
			]
  			offset: offset + parent/offset + edge-size
  			climber: parent
			if parent = screen-face [break]
  		]
  		
  		if all [animate not empty? animations][

  			; remove old animator handler if there is one
  			if ctx-anim [remove-event-func get in ctx-anim 'animator]
  			  			
			; build animation handler function
			ctx-anim: context compose/only [
				animations: (animations)
				start-time: none
				total-time: 200
				elapsed: none
				tp: none ; time progress/path/parametrised, values between 0.0 and 1.0
				
				animator: func [face event][
					if event/type = 'time [
						either start-time [
							elapsed: event/time - start-time
							tp: min 1.0 elapsed / total-time
							if tp <= 1.0 [
								foreach [scroll-panel old new] animations [
								
									; simple linear scroll
									;scroll-panel/access/set-scroll-offset scroll-panel (new - old * tp + old)
									
									; accelerate / decelerate
									tp: either tp < 0.5 [2 * tp * tp][1.0 - (2 * (1.0 - tp) * (1.0 - tp))]
									scroll-panel/access/set-scroll-offset scroll-panel (new - old * tp + old)
								]
							]
							
							if elapsed > total-time [
								remove-event-func :animator
							]
						][
							start-time: event/time ; first event, just record the time
						]
					]
					event ; allow event to continue
				]
				
				; insert handler function
				insert-event-func :animator
			]
			
			; start time events
  			animations/1/rate: 2 ; Set the first scroll-panel RATE
  			show animations/1
		]
		
	]
]