event.r

REBOL [
	; -- Core Header attributes --
	title: "Glass Event stream handler"
	file: %event.r
	version: 1.0.7
	date: 2013-9-17
	author: "Maxim Olivier-Adlhoch"
	purpose: {Complete rewrite of view input stream management.  Specifically tailored to GLASS.}
	web: http://www.revault.org/modules/event.rmrk
	source-encoding: "Windows-1252"
	note: {slim Library Manager is Required to use this module.}

	; -- slim - Library Manager --
	slim-name: 'event
	slim-version: 1.2.1
	slim-prefix: none
	slim-update: http://www.revault.org/downloads/modules/event.r

	; -- Licensing details  --
	copyright: "Copyright © 2013 Maxim Olivier-Adlhoch"
	license-type: "Apache License v2.0"
	license: {Copyright © 2013 Maxim Olivier-Adlhoch

	Licensed under the Apache License, Version 2.0 (the "License");
	you may not use this file except in compliance with the License.
	You may obtain a copy of the License at
	
		http://www.apache.org/licenses/LICENSE-2.0
	
	Unless required by applicable law or agreed to in writing, software
	distributed under the License is distributed on an "AS IS" BASIS,
	WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
	See the License for the specific language governing permissions and
	limitations under the License.}

	;-  / history
	history: {
		v1.0.7 - 2013-09-17
			-License changed to Apache v2
}
	;-  \ history

	;-  / documentation
	documentation: {
	
	  --------------------
		DANGER:  the hold() function was patched (see comment there) but current side-effects are unknown (if any)
		         if you are using any modal dialogs on application start, it may cause your app to start handling
		         events early.  while this usually shouldn't be cause for concern, it may break some apps.
		         
		         if you have this issue, uncomment the line in the hold function, but know that you then can't have
		         early modal dialogs(before calling do-events), since the app needs to have started handling 
		         events for it to work.
	  ---------------------
	
		This library implements the event stream system as used by GLASS.  It allows many advanced event
		manipulations including event stream recording, queuing custom events and stream transformations.
		
		There are several levels of handlers, each of which may have several handlers.
		All handlers are linked dynamically, so the stream can be expanded on the fly.
		
		The stream is also responsible for handling non-view events like GUI refreshes
		and focus events, generated by marbles themselves.
		
		Because several handlers may process the same event, we have great flexibility in how
		events may be manipulated, especially since the same event can now trigger several
		callbacks, and even generate several new events.
		
		Also note that an event may be consumed by any handler, so some care must be taken in
		how handlers are implemented (its easy to corrupt display when expected events 
		are missing downstream).
		
		This library is still undergoing some upgrades and not all features are enabled or even
		implemented yet.
		
		Expect a good deal of overhaul in some areas, so future releases might break current code.
		Don't use this library directly, unless you are prepared for some maintenance down the road.
		Generally, the event queuing is not expected to change in the future, so that is safe to use.
	}
	;-  \ documentation
]



;--------------------------------------
; unit testing setup
;--------------------------------------
;
; test-enter-slim 'event
;
;--------------------------------------

slim/register [

	view*: system/view

	;- LIBS
	;   
	liquid-lib: slim/open/expose 'liquid none [
		!plug 
		retrieve-plug
		liquify*: liquify 
		content*: content 
		fill*: fill 
		link*: link
		unlink*: unlink
		detach*: detach
	]
	
	slim/open/expose 'glass-core-utils none [  search-parent-frames  ]

	
	glob-lib: slim/open 'glob none

	;-   
	;-  GLOBALS

	;-     last-move-position
	; remember last move coordinates so we can trigger it on time events.
	last-move-position: 0x0
	
	
	;-     last-down-event
	; remember the mouse down event which switches moves to swipe/drop?
	last-down-event: none
	
	
	;-     last-move-event:
	; when mouse throttling is enabled, this is where we store mouse events until they are handled at
	; a time event.
	last-move-event: none
	
	
	;-     hold-count:
	; each time hold is called, this is incremented,
	; each time resume is called,  its decremented.
	;
	; resume will do nothing, if this is 0.  preventing the initial wait from terminating
	hold-count: 0
	
	
	;-     resume?:
	; if this is set to true, the wake event will kill the current wait loop.
	; note: will be ignored if hold-count < 1
	resume?: none
	
	
	;-     last-wake-event:
	; this event (object! or none!) is used to keep track of the CURRENT cloned event which triggered a dispatch.
	;
	; the reason we need this is to be able to refer to it when implementing dispatch-event
	; directives.
	;
	; that function will inspect the event/action to determine if its been directed to do 
	; something very low-level... like interrupt current event with a new wait,
	; or release of that interruption by returning none from itself.
	last-wake-event: none
	
	
	;-     immobile-start:
	; this is used to determine how many times the timer-based move event occured
	; its usefull to create an 'immobile action.
	immobile-start: none
	
	
	;-     GLASS-THROTTLE-MOUSE:
	; a global which tells this wake-event to postpone mouse events so they only occur just before time events.
	; 
	; be VERY carefull:
	;     -if you don't have any window with a rate, mouse handling is effectively nullified
	;     -key events might occur out-of order.
	;
	; its set as a global, since control of this must be application wide.
	set 'GLASS-THROTTLE-MOUSE true
	
	
	
	
	;-     focused-marble:
	; link any marble here so it receives focused keyboard events.
	;
	; focused keyboard events are triggered by the 'focus' input filter.
	focused-marble: liquify* !plug
	
	
	hot-keys: []
	
	
	;-     !event[]
	!event: context [
		;-         action:
		; current event type (it may evolve!)
		action: none          

		;-         marble:
		; stores the destination for the event, changes as streaming progresses.
		marble: none          

		;-         view-window:
		; what window face originated this event.
		view-window: none     

		;-         viewport:
		; stores the !viewport face which is responsible for this event.
		; note that in some setups, there may be several !viewports -> (<TO DO>: delayed feature)
		viewport: none        

		;-         coordinates:
		; where was the pointer when the event occured? (may evolve as we go from event->windows->marble)
		coordinates: none
		
		;-         offset:
		; above coordinates, converted to local offset, relative to position and 
		; frame transformations (translation/scale, if any)
		;
		; marble handlers will usually use this value instead of coordinates.
		;
		; note that windows/viewports are responsible for setting this value
		offset: none

		;-         key:
		; was the keyboard involved in the event?
		key: none            

		;-         control?:
		; was the control key pressed?
		control?: none        

		;-         shift?:
		; was the shift key pressed?
		shift?: none          

		;-         tick:
		; the event/time integer in milliseconds 
		; when the mouse is immobile over the active window,
		; move events are generated by view... we use this value
		; directly to create an 'immobile action (ticks usually happen twice a second)
		tick: none            
	]
	
	
	;-     event-queue:
	;
	; use the queue-event() function to add events here.
	;
	; used by the streaming engine to store created events while another event is being processed.
	; usually the queue will be empty.
	;
	; when an event is finished dispatching, the engine will see if there are new events in the queue
	; and start the process again.
	;
	; you can use the event-queue to re-order events...
	;
	; example:, a mouse click occurs.. you detect that the marble can be focused.
	; instead of managing the focus within the mouse handler... you generate new
	; unfocus & focus events.
	;
	; the stream engine will then start a new dispatch with the unfocus, and another with the focus.
	; this makes it possible for each part of glass to react to events, without requiring you to 
	; know how other systems manage events.
	;
	; when an event simply changes to another event type, just return the new (or modified) event
	; from the handler... no need to create a new event in this case.
	;
	; when the GLASS-THROTTLE-MOUSE is enabled, time events will use this system to stream the last stored
	; mouse event before the time event.
	event-queue: []


	;-     automation-queue:
	;
	; only used when playback? is true
	;
	; just like the event queue, but can be stalled by setting paused-playback? to true
	;
	; also, the queue is handled in a different way. we progress through the list one event
	; at a time and set the list to the next item (without removing anything)
	;
	; this way it can be paused and progress can resume at any time.
	;
	automation-queue: []
	
	
	;-     stream:
	; stores event processing functions.
	; the event library stream will be responsible for shooting off events to the window stream
	;
	; streaming allows us to implement various event manipulations in a decoupled manner.
	;
	; we can implement special features like hotkeys, add or even remove input events on the fly.
	;
	; the fact that windows have their own stream allows a good degree of flexibility.
	;
	; things like modality are handled within the stream.
	;
	; the stream handlers are labeled, for easy manipulation and reference.
	;
	; you must use the various handler functions to manipulate this.
	stream: []
	
	
	;-     recording?:
	;
	; tells the core-glass-handler to start recording events.
	;
	; only root level (view) events are recorded, so any marble-generated events get processed normally.
	; and will stream as they should.
	;
	; recording is very handy to reproduce user interaction and allows developpers to automate testing
	; of new GUI features, to see if they perform as desired using a recorded event stream.
	;
	; a file storage/retrieval api is also provided, making it very easy to create a complete
	; solution for application macro, unit testing purposes, automated document generation and more
	;
	; you must not change window titles between recording and playback, nor should you modify
	; the layout between tests, cause things like mouse clicks will affect new marbles.
	recording?: false
	
	
	;-     record-events:
	;
	; tells the recording system what it should log.  
	;    true, means log everything.
	;    it can also be a block of event/action names to match
	record-events: true
	
	
	
	;-     event-log:
	; when recording is enabled, view events are stored here.  we can run automate on the list after
	;
	; 'activate events are stored as activate-window events instead, which allow the engine to
	; CAUSE a window activation instead.
	event-log: []
	
	
	;-     playback?:
	; enables automation playback, prevents new event recording, and post-pones normal event processing.
	;
	; causes the wake-even() to call do-automation() instead of real events.
	;
	; normally queued events cannot be interrupted (events triggered by marbles which end up in event-queue) but once all
	; queued-events are done, the next automation event may be stalled, see paused-playback?: below.
	;
	playback?: false
	
	
	;-     paused-playback?:
	;
	; interrupts the automation playback when set to true.
	;
	; because time events occur normally, the queue will be verified periodically.
	;
	; note that to set the value of paused-playback? you need to have an external control
	; over the GLASS application.  this is commonly done using a normal view window
	; or tcp port as a trigger.
	paused-playback?: false
	
	
	;-     play-delay:
	; when dispatching an automation, wait this time period before continuing.
	;
	play-delay: 0.2
	
	
	
	
	;-   
	;- FUNCTIONS
	
	
	;-----------------
	;-     clone-event()
	;
	;  note: /with block! only works with object! events
	;-----------------
	clone-event: func [
		event [object! event!]
		/with e [event! block!] "when cloning !event objects, transfer event! type values into it"
	][
		if event? event [
			; this is an internal view event!
			e: event
			event: !event
		]
		
		; clone the glass event.
		either block? e [
			event: make event e
		][
			event: make event []
		]
		
		; carry over any view event properties into glass
		if event? e [
			event/coordinates: e/offset
			event/key: e/key
			event/action: e/type
			; be carefull because at different stages, this face can change, especially
			; if there are multiple !VIEWPORTs in a single window.
			event/view-window: e/face
			event/control?: e/control
			event/shift?: e/shift
			event/tick: e/time
;			if e/type = 'down [
;				print ["event/ticks: " e/time]
;				print ["event/ticks: " event/tick]
;			]
		]
		event
	]
	
	
	
	;-----------------
	;-     queue-event()
	; 
	; add specified event on the queue.
	;-----------------
	queue-event: func [
		event [object! block!]
		/automated "add to automation queue instead, used by recording and direct call to automated"
	][
		vin [{queue-event()}]
		;print "QUEUING EVENT!"
		if block? event [
			event: clone-event/with !event event
		]
		
		
		either in event 'action [
			append either automated [automation-queue][event-queue] event
		][
			to-error "GLASS/Event.r/queue-event() ATTEMPT TO QUEUE INVALID OBJECT!"
		]
		vout
	]
	
	
	;-----------------
	;-     make-event()
	;-----------------
	make-event: func [
		spec [block!]
	][
		;vin [{make-event()}]
		make !event spec
		
	]
	
	;-----------------
	;-     flush-queue()
	;-----------------
	flush-queue: func [
	][
		vin [{flush-queue()}]
		clear event-queue
		vout
	]
	
	
	
	
	;-----------------
	;-     do-queue()
	;-----------------
	do-queue: func [
		/local gl-event trigger trigger-action done?
	][
		;vin [{do-queue()}]
		
		; process normal queue
		until [
			if gl-event: pick event-queue 1 [
				either trigger: get in gl-event 'trigger-event [
					;vin "trigger-event()"
					switch/default type?/word :trigger [
						date! [
							;print "timed trigger"
							either now/precise > trigger [
								;print "event-triggered event!"
								;print trigger
								remove event-queue
								if function? trigger-action: get in gl-event 'trigger-action [
									event: trigger-action gl-event
									if object? event [
										;vprint "trigger()"
										;vprobe event/trigger-repeat-delay
										if event/trigger-repeat-delay [
											event/trigger-event: now/precise + event/trigger-repeat-delay
										]
										append event-queue event
									]
								]
							][
								;---
								; skip the event, its not ready.
								event-queue: next event-queue
							]
						]
					][
						;---
						; if the trigger-event is invalid, we just dispatch it  
						; like, a normal event
						remove event-queue
						dispatch gl-event
					]
					;vout
				][
					remove event-queue
					dispatch gl-event
				]
			]
			
			empty? event-queue
		]
		; in case we skipped some un-triggered events
		event-queue: head event-queue
		;vout
	]
	
	
	
	
	;--------------------------
	;-     queue-delayed-trigger()
	;--------------------------
	; purpose:  
	;
	; inputs:   
	;
	; returns:  
	;
	; notes:    
	; 	to build repeating events, the action() determines if the event is 
	; 	requeued by returning an event (usually the event it received).
	;	in such a case, make sure to add a delay to the trigger-next, if you need it.
	;
	; 	if the trigger action returns none, the event is NOT requeued, and the
	; 	repeat action is pointeless.
	;
	; tests:    
	;--------------------------
	queue-delayed-trigger: funcl [
		delay [time! date! integer! decimal! none!]  ; number values are in seconds, functions are executed at each 
		action [function! block!] "what to do when delay is passed, when given a block, 'EVENT is set to the trigger event"
		/repeat-delay "when used, the trigger delay is automatically calculated after the action returns an event."
		/label lname [word!] "give this trigger a label in order to recognize it later."
		/data user-data
	][
		vin "queue-delayed-trigger()"
		
		default lname 'time-trigger
		
		switch (type?/word :delay) [
			integer! decimal! [
				delay:  ( 0:0:1 * delay )
				if repeat-delay [
					repeat-delay: delay
				]
			]
			none! [
				delay: 0:00
			]
			date! [
				if repeat-delay [
					to-error "queue-trigger(): cannot use /repeat-delay on date delayed events"
				]
				; when given a date and repeat, we figure out the difference from date and now.
				delay: difference delay now/precise
			]
		]
		
		if block? :action [
			action: func [event] :action
		]
		
		--action--: :action
		
		;vprint "====>"
		event: make-event compose/only [
			event-label: lname
			
			trigger-event: now/precise + delay
			trigger-data: user-data
			trigger-action: :--action--
			
			trigger-repeat-delay: either repeat-delay [ delay ][ none ]
		]
		;vprint "<===="
		
		queue-event event
		
		vout
		event
	]
	
	
	
	
	;--------------------------
	;-     search-event-queue()
	;--------------------------
	; purpose:  retrieve an event based on a variety of criteria
	;
	; inputs:   
	;
	; returns:  
	;
	; notes:    requires a labeled event
	;--------------------------
	search-event-queue: funcl [
		/label lname [word!]
	][
		vin "search-event-queue()"
		case [
			label [
				foreach event event-queue [
					all [
						in event 'event-label
						word? get/any in event 'event-label
						return event ; found it don't 
					]
				]
			]
		]
		vout
	]
	
	
	
	
	;-----------------
	;-     handle-stream()
	;
	; adds/replaces a handler in an event stream
	; 
	; be carefull, given function is called for EVERY event
	;
	; if your handler needs any persistent values, wrap the function within
	; a context, and call handle-stream from within the context.
	;
	; be careful, if the named handler already exists, it WILL be replaced.
	;-----------------
	handle-stream: func [
		name [word!]
		handler [function!]
		/before bhdlr [word!] "add before handler"
		/after ahdlr [word!] "add after handler"
		/within strm [block! object!] "add a handler to a marble or viewport"
	][
		vin [{handle-stream()}]
		either (copy/part third :handler 2) = compose/deep [event [(object!)]] [
			vprint "HANDLER COMFORMS!"
			
			; use glass stream or marble's own stream
			strm: any [strm stream]
			
			; reuse or create a new stream for a specified marble
			if object? strm [
				; object MUST be a marble
				strm: strm/stream: any [strm/stream copy []]
			]
			
			;vprint length? strm
			
			
			append strm name
			append strm :handler
			
		][
			vprobe  (copy/part third :handler 2)
			to-error "GLASS/Event.r/handle-stream() requires first argument specification of given handler function to be 'event [object!]'"
		]
		vout
	]
	
	
	;-----------------
	;-     bypass-stream()
	; removes a handler from an event stream
	;-----------------
	bypass-stream: func [
		name [word!]
		/from strm [block!]
	][
		vin [{bypass-stream()}]
		strm: any [strm stream]
		vout
	]
	
	

	;-----------------
	;-     do-automation()
	;-----------------
	do-automation: func [
		/local gl-event
	][
		vin [{do-automation()}]
		unless paused-playback? [
			until [
				
				; get automation event 
				if gl-event: pick automation-queue 1 [
					;print ["^/---------------^/automation events left: " length? automation-queue]
					;probe gl-event/action
					;print ["^/---------------^/event log: " length? event-log]
					
					remove automation-queue
					
					wait play-delay
					dispatch clone-event gl-event
					
					; trigger wake-event... smoother for view?
					wait 0
					
					; the automated event might have generated queued events.
					;print ["^/---------------^/queue: " length? event-queue]
					do-queue
				]
				
				; are we done?
				any [
					paused-playback? ; automation was interrupted
					empty? automation-queue ; all done
				]
			]
			
			; disable automation and reset automation-queue to its head.
			if empty? automation-queue [
				; we're done!
				reset-automation
			
			]
		]
		
		
		vout
	]
	
	

	
	;-----------------
	;-     automate()
	;
	; given a block of events or event block specs, perform each event using specified delay
	;
	; any events triggered by wake-event will be ignored, exception of time events.
	;
	; when automate is called, playback? is set to true and wake-event will start to ignore
	; its own events.
	;
	; setting paused-playback? will stop do-automation from processing its queue, 
	; giving wake-event the chance to re-trigger it on time events.
	;-----------------
	automate: func [
		events [block!]
		delay [integer! decimal!]
		/paused
		/local event
	][
		vin [{automate()}]
		
		reset-automation
		foreach event events [
			queue-event/automated event ; /automated will add the event to automation-queue
		]
		playback?: true
		paused-playback?: paused ; make sure we don't start paused by default, but allow as an option.
		
		play-delay: delay
		do-automation
		vout
	]
	
	;-----------------
	;-     reset-automation()
	;
	; quits playback, clears automation-queue to its head and exits pause mode.
	;
	; doesn't touch event-log, since that is specifically recording related.
	;-----------------
	reset-automation: func [
		
	][
		vin [{reset-automation()}]
		playback?: false
		
		paused-playback?: false
		
		automation-queue: head clear head automation-queue
		vout
	]
	
	
	
	
	;-----------------
	;-     start-recording()
	;
	; enables event logging, also resets the log, if already recording
	;
	; note that we do not record time events, since they will only 
	; generate noise.   normal time ticks will occur as usuall once
	; playback is started, so any time sensitive events will still
	; occur, but have current time instead of original time.
	;
	; refresh rate is also independent of recording, so you can record at
	; high-rate, slow down refresh, then playback.
	;
	; this ultimately allows you to run the playback at cpu speed, if its not
	; dependent on time information. 
	;
	; /only allows you to specify a list of event/action types you wish to remember
	;       note that the block is NOT copied and may be modified at runtime
	;-----------------
	start-recording: func [
		/only events [block! word!]
	][
		vin [{start-recording()}]
		
		; flush event log
		event-log: copy []
		
		; pause play
		stop-playback
		
		; set recording stat to true
		recording?: true
		
		if only [
			if word? events [
				events: compose [(events)]
			]
			record-events: events
		]
		
		vout
	]
	
	
	;-----------------
	;-     record-event()
	;
	; depending on event types, we record event or not.
	;
	; only events generated by view whould be submitted here.
	;-----------------
	record-event: func [
		event [object!] "This must be a COPY of original !event object"
	][
		vin [{record-event()}]
		
		; we ignore useless time events.
		either event/action = 'time [
			;prin "."
		][
			
			
			switch/default event/action [
				move key down up [
					append event-log event
				]
				; these events CAUSE activation to change.  we use different action names, to make sure
				; no activate cycle is caused. (just like resizing "feedback")
				active [
					event/action: 'ACTIVATE-WINDOW!
					append event-log event
				]
				inactive [
					event/action: 'DEACTIVATE-WINDOW!
					append event-log event
				]
				resize [
					event/action: 'RESIZE-WINDOW!
					; the coordinates are the actual mouse position while resizing window,
					; so we change the value for the window's new size
					event/coordinates: event/view-window/size
					append event-log event
				]
				offset [
					event/action: 'MOVE-WINDOW!
					; the coordinate is the actual mouse position while dragging window
					; we substitute the value for new offset
					event/coordinates: event/view-window/offset
					append event-log event
				]
			][
				;print "Not recording:"
				;print event/action
				;print event/coordinates
			]
		]
		vout
	]
	
	
	
	
	;-----------------
	;-     stop-recording()
	;-----------------
	stop-recording: func [
	][
		vin [{stop-recording()}]
		recording?: false
		vout
	]
	
	
	
	
	;-----------------
	;-     pause-recording()
	;-----------------
	pause-recording: func [
		
	][
		vin [{pause-recording()}]
		vout
	]
	
	
	;-----------------
	;-     store-recording()
	;
	; allows you to store a recording for later retrieval using the restore-recording.
	;
	; note that the view-window property must be wiped out when an automation is stored. 
	; we replace it with the window's title.
	;
	; when the recording is later restored, we try to match the Title with any opened window,
	; if any are opened. 
	;
	; if none matched (usually cause they are not yet opened), we delay the process, and 
	; let do-automation map it out a run-time.
	;
	; note: event/ticks are not cleared at this time.  its possible that this could be a 
	;       slight privacy risk since someone could determine time of event by scanning file.
	;
	;       in a further release, we could anonymise this by calculating an offset from first
	;       tick wrt every other, and then restore current tick time when do-automation is performed.
	;-----------------
	store-recording: func [
		/name filename [word! file! url!]
		/safe "do not overwrite previous recording!"
		/local file event
	][
		vin [{store-recording()}]
		;print "STORE RECORDING!"
		if word? filename [
			filename: to-file join to-string filename ".gler" ; gler = glass event recording.
		]
		
		filename: any [filename %glass-event-recording.gler]
		
		
		if all [
			safe
			exists? filename
		][
			; <TO DO>  pop up a requestor instead?
			; error is meant to make it easier to trap when debugging.
			to-error "GLASS tried to overwrite event recording, but application asked not to!"
		]
		
		; make sure we have access to disk or url
		if file: attempt [write filename "" copy ""] [
			
			foreach event event-log [
				; replace window by its title
				event/view-window: event/view-window/text
				
				; clear fields which will be filled out by core handler (if they are filled for some reason)
				event/viewport: none
				
				
				; event
				append file mold/all event
			
			]
			
			write filename file
			
		]
		vout
	]
	
	
	;-----------------
	;-     restore-recording()
	;-----------------
	restore-recording: func [
		/name filename [word! file! url!]
		/local window windows item
	][
		vin [{restore-recording()}]
		filename: any [filename %glass-event-recording.gler]
		v?? filename

		if word? filename [
			filename: to-file join to-string filename ".gler" ; gler = glass event recording.
		]

		if attempt [
			if exists? filename [
				data: load filename
			]
		][
;			probe data
;			print "!!!!!!!!!!!!!!!!!!!!!!!!!"
;			probe type? system/view/screen-face/pane
;			print "!!!!!!!!!!!!!!!!!!!!!!!!!"
;			print length? system/view/screen-face/pane
;			probe windows
			windows: copy []
			foreach window system/view/screen-face/pane [
				;print window/text
				append windows window/text
				append windows window
			]
			; attempt to re-link window to its title right away
			foreach item data [
				if window: select windows item/view-window [
					;print "window title match!"
					item/view-window: window
				]
			]
		]
		event-log: data
		clear windows
		windows: item: window: data: none
		
		vout
	]
	
	
	
	;-----------------
	;-     set-recording()
	;-----------------
	set-recording: func [
		
	][
		vin [{set-recording()}]
		vout
	]
	
	
	
	;-----------------
	;-     stop-playback()
	;-----------------
	stop-playback: func [
		
	][
		vin [{stop-playback()}]
		reset-automation
		vout
	]
	
	
	
	
	;-----------------
	;-     playback-recording()
	;-----------------
	playback-recording: func [
		/speed spd [integer! decimal!]
	][
		vin [{playback-recording()}]
		
		recording?: false
		
		; tells the engine to ignore new events we might cause.
		; example, moving mouse over window will not be recognised while playback occurs.
		playback?: true
		
		; make sure we're not paused.
		paused-playback?: false
		
		spd: any [spd 0.05]
		
		
		vprobe length? event-log
		vprobe length? automation-queue
		automate event-log spd
		vout
	]
	
	
	
	
	
	
	

	
	;-----------------
	;-     marble-at-coordinates()
	;
	; the nitty gritty function which converts a color from an image at a specific offset
	; and returns the associated liquid plug.
	;
	; note that the image size and range of offset must match exactly.
	;  if you specify coordinates which are out of bounds, an error or wrong plug WILL happen.
	;-----------------
	marble-at-coordinates: func [
		image [image!]
		offset [pair!]
	][
		retrieve-plug glob-lib/to-sid pick image offset/y + 1 * image/size/x + offset/x
	]
	
	
	
	;-----------------
	;-     coordinates-to-offset()
	;
	; given a marble and coordinates, will return the offset of the coordinates
	; to that marbles's position, including ALL parent transformation by panes or
	; otherwise.
	;
	; currently, only translation is managed, but we might add scaling at some point.
	; this would be very usefull for some applications.
	;
	; translation is calculated by moving up the frame stack and collecting any
	; marble/material/translation attributes it finds, adding them all up and
	; removing that from the given coordinate
	;
	; this function is intended for use by the event mechanism.
	;
	; <TO DO> accelerate the process by using some kind of marble cache which stores
	;         collected translation nodes.
	;
	;         this process will have to be managed by the collect/discard/fasten process
	;         but must be optimal so it doesn't get re-applied at each level of a collect
	;         tree of frames.  otherwise it would be exponentially slow as frames are layered
	;         deeper and deeper.
	;
	;
	; note that for now, the function is SAFE in that is checks datatypes, while
	; development ensues, but at some point, it will become unsafe and will
	; expect the translations to be setup properly, or not at all.
	;  
	; this will speedup lookup a bit, but should not account for much speed gains.
	; the current implementation is already sufficiently fast for R/T interactivity.
	;
	;-----------------
	coordinates-to-offset: func [
		marble [object!]
		coordinates [pair!]
		/local offset w frm position
	][
		;vin [{coordinates-to-offset()}]
		;print ""
		
		;probe type? marble
		;probe words-of marble
		
		;?? coordinates
		position: content* marble/material/position
		;?? position 
		offset: coordinates - position
		
		;?? offset
		if frm: marble/frame [
			until [
				if object? w: get in frm/material 'translation [
					;if object? w: get w [
						if pair? w: content* w [
							;?? w
							offset: offset - w
						]
					;]
				]	
				if object? w: get in frm/material 'translation-origin [
					;if object? w: get w [
						if pair? w: content* w [
							;?? w
							offset: offset - w
						]
					;]
				]	
;				if object? w: get in frm/material 'inner-offset [
;					probe "found inner-offset"
;					;probe 
;					;if object? w: get w [
;						if pair? w: content* w [
;							?? w
;							offset: offset + w
;						]
;					?? offset
;					;]
;				]	
				none? frm: frm/frame
			]
		]
		;?? offset
		;vout
		
		offset
	]
	
	
	
	;-----------------
	;-     offset-to-coordinates()
	;
	; this takes a marble, an offset from it and returns the window
	; coordinates which map to it.
	;
	; its usefull to translate the transformation matrix from one arbitrary
	; marble to another, or to position things globally relative to a marble,
	; like in popups, on reveal().
	;
	; note that for now, the function is SAFE in that is checks datatypes, while
	; development ensues, but at some point, it will become unsafe and will
	; expect the translations to be setup properly, or not at all.
	;  
	; this will speedup lookup a bit, but should not account for much speed gains.
	; the current implementation is already sufficiently fast for R/T interactivity.
	;-----------------
	offset-to-coordinates: func [
		marble [object!]
		offset [pair!]
		/local coordinates w frm position
	][
		vin [{offset-to-coordinates()}]
		;print ""
		;?? coordinates
		position: content* marble/material/position
		;?? position 
		coordinates: offset + position
		
		;?? offset
		if frm: marble/frame [
			until [
				if w: in frm/material 'translation [
					if object? w: get w [
						if pair? w: content* w [
							;?? w
							coordinates: coordinates + w
						]
					]
				]	
				if w: in frm/material 'translation-origin [
					if object? w: get w [
						if pair? w: content* w [
							;?? w
							coordinates: coordinates + w
						]
					]
				]	
				none? frm: frm/frame
			]
		]
		;?? offset
		;vout
		
		coordinates
	]
	
	
	
	
	
	;-     WAKE-EVENT()
	view*/wake-event: func [
		port 
	] bind [
		;event: pick port 1
		if resume? [
			resume?: false
			if hold-count > 0 [
				hold-count: hold-count - 1
				;queue-event compose [viewport: (last-wake-event/viewport) action: 'resume]
				return true
			]
		]

		dispatch-event pick port 1	
	] in view* 'self

;		; not shure if this is EVER triggered!
;		if none? event [
;			return false
;		]
;		
;		;----------------------------------
;		; kill-wait, feature on hold
;		;
;		; basically an event handler interrupt
;		;
;		; this is used to allow faces to use wait so faces within a window may act as modal actions.
;		; event blocking in main window is up to the face to handle, but now, at least the function
;		; calling the popup can return a value directly.
;		;
;		; this allows for "cancel" boxes in some difficult circumstances or things like
;		; network handlers which can interfere with the GUI, causing a modal popup to close
;		; by itself, when an async xfer is done.
;		;
;		; needs testing to be re-instated within GLASS
;;		if value? 'kill-wait? [
;;			if kill-wait? [
;;				kill-wait?: none
;;				return true
;;			]
;;		]
;		
;		;
;		
;		
;		;-          -Mouse move throttling
;		; prevents glass from accumulating mouse events when its not feasible.
;		; mouse events will then be sent just before the next time event.
;		;
;		; this immediately tunes the maximum mouse rate to the refresh rate of your app.
;		;
;		; since mouse events are always sent just before the time events, this also optimises
;		; refresh to a single redraw per mouse move.
;		;
;		; with the liquid propagate() optimisation, this is less valuable than it used to be.
;		; but with a graphic application this can still make a big difference
;		if GLASS-THROTTLE-MOUSE [
;			if event/type = 'move [
;				move-event: event
;				return empty? screen-face/pane
;			]
;			
;			if event/type = 'time [
;				if move-event [
;					do move-event
;				]
;				do event
;				move-event: none
;			
;				return empty? screen-face/pane
;			]
;		]
;
;;		if event/type = 'key [
;;			; since we're going to do it anyways in edit-text, The algorythm has changed,
;;			; in order to allow mapped keys to be given to the hot-key handlers.
;;			mapped-key: map-keys event
;;			
;;			
;;			; use add-hotkey-handler to enable application-wide hotkeys.
;;			; these are not called within poped-up windows.
;;			if all [gbl-hotkeys empty? pop-list][
;;				if hot-action: select gbl-hotkeys mapped-key [
;;					consumed?: hot-action face event key 	; NB at this level, face is the window. use top-face, and win-offset, 
;;															; like the scrollwheel does below to react localy to whatever is under
;;															; the mouse when you press the hotkey.
;;				]
;;			]
;;			
;;		]
;
;		
;
;		; this is just to cure bugs which don't refresh some view internals when do event isn't called on the 
;		; window after a window-related events.
;		;
;		; the bug leaves the window face at its previous state, even though the window has resized, moved, etc.
;		if find [resize offset] event/type  [
;			;print "###############################"
;			;print event/type
;			;ask ""
;			; following line is basically a no-op, since window has no feel
;			do event
;		]
;
;		;-          -Event streaming
;		gl-event: clone-event event
;		
;		
;		either playback? [
;			; make sure the interface refreshes when playback is activated.
;			either find [time resize offset] gl-event/action [
;				consumed?: not dispatch gl-event
;				do-queue
;			][
;				; run
;				;do-automation
;			
;				;we consume all events during playback, for now
;				none
;			]
;			
;		][
;			if recording? [
;				; store a copy of the original event
;				rec-event: make gl-event []
;			]
;			
;			consumed?: not dispatch gl-event
;			
;			if gl-event/action = 'time [
;				;prin "."
;			]
;			
;			if recording? [
;				if rec-event/action <> 'time [
;					;print "^/-------------"
;					;print "??"
;					;print type? gl-event/viewport
;					unless any [
;						none? gl-event/viewport ; we don't record events which don't concern GLASS
;						
;					][
;						record-event rec-event
;					]
;				]
;			]
;			
;			; check queue
;			do-queue
;		]
;		;v?? consumed?
;		;vprint type? event
;
;
;		;------------
;		; provide minimal VID/View compatibility
;		;
;		; note that VID interaction might be affected, since it is called AFTER
;		; glass streaming.
;		;
;		; note that the whole VID pop-up system is deactivated when using GLASS...
;		; only normal windows will continue to function.
;		unless consumed? [
;			 
;;			either pop-face [
;;				if in pop-face/feel 'pop-detect [event: pop-face/feel/pop-detect pop-face event]
;;				do event
;;				found? all [
;;					pop-face <> pick pop-list length? pop-list
;;					(pop-face: pick pop-list length? pop-list true)
;;				]
;;			] [
;;	
;;				unless consumed? [
;					do event
;;				]
;;			]
;		]
;		
;		; following line might be replaced by something more controlable
;		empty? screen-face/pane
;				
;	] in view* 'self
;	
;	


	;-----------------
	;-     hold()
	;
	; interrupts interpreter, while a new event loop is handled.
	;
	; use resume to break the interruption
	;-----------------
	hold: func [
	][
		vin [{hold()}]
		;if last-wake-event [   ; NOTE : LINE WAS COMMENTED WITHOUT COMPLETE CONFIDENCE THIS WON'T GENERATE OTHER ERRORS.
								;        This may cause a wait toooo soon in some apps.
			vprobe "holding!"
			hold-count: hold-count + 1
			wait []
		;]
		vout
	]
	
	;-----------------
	;-     resume()
	;
	; tell the wake event to quit last event loop.
	;-----------------
	resume: func [
	][
		vin [{resume()}]
		resume?: true
		vout
	]
	
	


	;-----------------
	;-     dispatch()
	;
	; note: this function will eventually be optimised for speed, for now its kept
	;       as readable as can be, cause debugging events is quite complex.
	;-----------------
	dispatch: func [
		event [object!]
		/local handlers handle 
			rval ; used temporarily, will eventually be eliminated
	][
		;vin [{dispatch()}]
		
		; takes an event and streams it all the way to an actual marble.
		;
		; basicaly it runs every function in the streams until one returns something else than an object.
		;
		; false or none is just an indication to stop (event is consumed)
		; event-handlers might actually create new events which will be added in the event-queue.
		; wake-event will call dispatch until the queue is empty.
		;
		; the event you return from a handler is the one which is used, so it might actually be
		; a different object, with more properties or even of a different action type.
		;
		; a single call to dispatch manages all three streams (glass, window, marble).  this is
		; to promote a unity in the management of events... we could have added a dispatch for 
		; window and another for marbles, but then every stylist might create new dispatch models.
		; this isn't in the best interest of the end-programer.
		
		;--------
		; manage glass stream
		
		; skip labels
		handlers: next stream
		
		;vprobe event/action
		
		;vprint "glass stream"
		until [
			;vprint "handlers left:"
			;vprint length? handlers
			not if handle: pick handlers 1 [
				;vprint "HANDLING EVENT IN GLASS"
				; handle is a function!
				event: handle event
				
				; skip handler labels
				handlers: skip handlers 2
				
				not event
			]
		]
		
		
		;--------
		; manage window stream
		; part of the glass stream is to identify the viewport


		;vprint "viewport stream"
		;vprint type? event
		if all [
			event
			event/viewport
			; skip label
			handlers: next event/viewport/stream
		][
			until [
				not if handle: pick handlers 1 [
					;vprint "HANDLING EVENT IN VIEWPORT"
					
					event: handle event
					handlers: skip handlers 2
					
					not event
				]
			]
		]		
		
		
		;--------
		; manage marble stream
		; part of the viewport stream's job is to identify the marble.
		;
		; by default the extremely fast backplane method is used.
		;vprint "marble stream"
		;vprint type? event
		if all [
			event
			event/marble
			in event/marble 'stream
			block? event/marble/stream
			handlers: next event/marble/stream
		][
			until [
				not if handle: pick handlers 1 [
					event: handle event
					handlers: next handlers
					
					not event
				]
			]
		]
		
		
;		vprint type? event
;		if event [
;			if event/marble [
;				; we ended up at a marble, 
;				event: none
;			]
;		]
;		
;		
;		; if the event is fully consumed by any handler, or we encounter a viewport
;		; it means glass was the intended target of the event.
;		if event [
;			either all [
;				event/viewport
;				
;			][
;				none
;			][
;				event
;			]
;		]
		
		
		; there are three types of return values for dispatch
		;    1) un-managed events (GLASS didn't handle the event itself, so its meant for another gui (VID?))
		;    2) none.  event is consumed, do nothing with it.
		;    3) directives, packaged as special event/actions which the wake-event understands.
		;
		; directives may only be used from within an event dispatched by wake-event itself.
		; this means you MAY NOT queue directives.
		rval: all [
			event
			any [
				; directives
				event/action = 'interrupt ; causes a modal wait
				event/action = 'continue ; frees the interrupt
					
				; was event meant for a GLASS window?
				not event/viewport
			]
			
			
			; we return event only if all prior conditions expect us to do so
			event
		]
		
		;vout
		rval
	]
	
	
	;-----------------
	;-     dispatch-event()
	;
	; used directly by wake-event, but can also be used manually.
	;-----------------
	dispatch-event: func [
		event
	] bind [
		
		; not shure if this is EVER triggered!
		if none? event [
			return false
		]
		
		;----------------------------------
		; kill-wait, feature on hold
		;
		; basically an event handler interrupt
		;
		; this is used to allow faces to use wait so faces within a window may act as modal actions.
		; event blocking in main window is up to the face to handle, but now, at least the function
		; calling the popup can return a value directly.
		;
		; this allows for "cancel" boxes in some difficult circumstances or things like
		; network handlers which can interfere with the GUI, causing a modal popup to close
		; by itself, when an async xfer is done.
		;
		; needs testing to be re-instated within GLASS
;		if value? 'kill-wait? [
;			if kill-wait? [
;				kill-wait?: none
;				return true
;			]
;		]
		
		;
		
		
		
		;-          -Mouse move throttling
		; prevents glass from accumulating mouse events when its not feasible.
		; mouse events will then be sent just before the next time event.
		;
		; this immediately tunes the maximum mouse rate to the refresh rate of your app.
		;
		; since mouse events are always sent just before the time events, this also optimises
		; refresh to a single redraw per mouse move.
		;
		; with the liquid propagate() optimisation, this is less valuable than it used to be.
		; but with a graphic application this can still make a big difference
		if GLASS-THROTTLE-MOUSE [
			if event/type = 'move [
				last-move-event: event

				; the generic end of windowed application return value
				return empty? screen-face/pane
			]
			
			if event/type = 'time [
				; execute move out of order.
				if last-move-event [
					; we only verify if the manage-event returned TRUE, which means to stop the wake-event.
					; any other return value is ignored.
					;
					; this allows us to build a situation where mouse moves may be the cause for
					; resuming from an interrupt (moving out of modal menu)
					either true =  manage-event last-move-event [
						return true
					][
						do event
					]
					last-move-event: none
				]
			]
		]

;		if event/type = 'key [
;			; since we're going to do it anyways in edit-text, The algorythm has changed,
;			; in order to allow mapped keys to be given to the hot-key handlers.
;			mapped-key: map-keys event
;			
;			
;			; use add-hotkey-handler to enable application-wide hotkeys.
;			; these are not called within poped-up windows.
;			if all [gbl-hotkeys empty? pop-list][
;				if hot-action: select gbl-hotkeys mapped-key [
;					consumed?: hot-action face event key 	; NB at this level, face is the window. use top-face, and win-offset, 
;															; like the scrollwheel does below to react localy to whatever is under
;															; the mouse when you press the hotkey.
;				]
;			]
;			
;		]

		manage-event event


				
	] in view* 'self
	
	
	;-----------------
	;-     manage-event()
	; the low-level event handling code.
	;
	; this causes high-level dispatch as well as controls application of event directives.
	;
	; this was previously part of dispacth-event(), but ended up being required twice in that
	; same function, so it was ripped out.
	;
	; note that our return value ends up being used DIRECTLY by wake-event.
	;-----------------
	manage-event: func [
		event
		/local consumed? gl-event rec-event
	] bind [
		; this is just to cure bugs which don't refresh some view internals when do event isn't called on the 
		; window after a window-related events.
		;
		; the bug leaves the window face at its previous state, even though the window has resized, moved, etc.
		if find [resize offset] event/type  [
			; following line is basically a no-op, since glass windows have no face/feel
			do event
		]

		;-          -Event streaming
		gl-event: last-wake-event: clone-event event
		
		
		either playback? [
			; make sure the interface refreshes when playback is activated.
			either find [time resize offset] gl-event/action [
				consumed?: not dispatch gl-event
				do-queue
			][
				; run
				; do-automation
			
				; we consume all events during playback, for now
				none
			]
			
		][
			if recording? [
				; store a copy of the original event
				rec-event: make gl-event []
			]
			
			consumed?: not dispatch gl-event
			
			;-          -Directives
			switch gl-event/action [
				; uncomment while debugging.
;				time [
;					prin "-->"
;					;wait none
;				]
				
				; causes a modal break in event handling.
				; this starts a new event loop on the stack.
;				interrupt [
;					PROBE "##################################################################"
;					 halt
;					PROBE "&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&"
;				]
				
				; frees the modal hold
				; breaks the current event loop, returning to the stack, from last hold
				;
				; the resume() function has a nifty "resume overun" protection.  always use it in code.
				;
				; this ensures that if one too many resumes is called, though this should be considered a bug, 
				; the application won't close unexpectedly.
				; 
				resume [
					return true
				]
			]
			
			if recording? [
				if all [
					rec-event
					rec-event/action <> 'time
					any [
						; we are recording EVERYTHING
						true = record-events
						
						; we listed a few events to capture.
						find record-events rec-event/action
					]
				][
					;print "^/-------------"
					;print "??"
					;print type? gl-event/viewport
					unless any [
						none? gl-event/viewport ; we don't record events which don't concern GLASS
						
					][
						record-event rec-event
					]
				]
			]
			
			; check queue
			do-queue
		]
		;v?? consumed?
		;vprint type? event


		;------------
		; provide minimal VID/View compatibility
		;
		; note that VID interaction might be affected, since it is called AFTER
		; glass streaming.
		;
		; note that the whole VID pop-up system is deactivated when using GLASS...
		; only normal windows will continue to function.
		unless consumed? [
			 
			either pop-face [
				if in pop-face/feel 'pop-detect [event: pop-face/feel/pop-detect pop-face event]
				do event
				found? all [
					pop-face <> pick pop-list length? pop-list
					(pop-face: pick pop-list length? pop-list true)
				]
			] [
	
;				unless consumed? [
					do event
;				]
			]
		]
		
		; following line might be replaced by something more controlable
		empty? screen-face/pane
	] in view* 'self
	
	
		
	;-----------------
	;-     dispatch-event-port()
	;
	; this manually grabs all events at event port and dispatches them thru glass event manager.
	;
	; using this function, we can dispatch events which are waiting even if we are
	; processing.  because system events like resize window or activate, will only trigger
	; once our processing is finished, which isn't very user friendly.
	;-----------------
	dispatch-event-port: func [
		/local event
	][
		vin [{dispatch-event-port()}]
		until [
			event: pick system/view/event-port 1
			
			dispatch-event event
			
			not event
		]
		vout
	]
	
	
	
	
	;-  
	;- HANDLER
	; add default handler(s) to glass
	; we wrap them in a context, so we don't pollute global space.
	context [
	
		; we define any locals here, so they don't get managed at each function call.
		viewport: none
	
		;-     tooltip-marble:
		; when a tooltip is shown, put its pointer here so we know to remove it later and 
		; to remember that we should only call a tooltip once.
		tooltip-marble: none
		
		;-     focused-marbles:
		; we store all focused marbles here
		; 
		; any text-input will then be forwarded to them. 
		focused-marbles: []
		
		;-     character-map-table:
		; this should eventually be part of the api.
		character-map-table: [
			#"^[" escape
			#"^M" enter
			#"^-" tab
			#"^~" erase-current  ; delete-key
			#"^H" erase-previous ; backspace key
			"ctrl+^~" erase-all
			"ctrl+shift+right" move-to-next-word
			"ctrl+right" move-to-next-word
			"ctrl+shift+left" move-to-previous-word
			"ctrl+left" move-to-previous-word
			#"^A" select-all
			#"^V" paste
			#"^C" copy
			#"^X" cut
			right move-right		
			left move-left
			up move-up
			down move-down
			home move-to-begining-of-line
			end move-to-end-of-line
		]
		
		
		;-     fast-click-delay:
		; set this in milliseconds
		fast-click-delay: 500
		
		;-     last-click:
		; stores moment of last mouse down
		; when it is below delay, the following down events have their 'fast-clicks attribute set to something else than none
		last-click: 0
		
		;-     fast-clicks?:
		; if the mouse down was a fast click, set this to true
		; further cliks will check and will increment the fast-click count until one goes beyond delay
		fast-clicks?: none
		
		
		
		context [
		
			compound-key-code: none
		
			;-     core-glass-handler()
			handle-stream 'core-glass-handler funcl [
				event [object!]
				/extern fast-clicks? immobile-start last-click last-wake-event last-down-event last-move-event last-move-position
			][
				
				unless find [move time] event/action [
					vin "event.r/core-glass-handler()"
					vout?: true
;					PRINT "CORE GLASS HANDLER()"
;					vprint ">>>>>>>>>>>>>>>>"
;					vprint event/action
				]
				;vprint ["event-window: " type? event/view-window]
				;vprint ["window title: " event/view-window/text]
				;vprint event/coordinates


				;--------------------------------------
				; These special events need no window or viewport
				;
				; it is possible, that the actions will resolve these on their own.
				;
				; note that these events may not directly control the return state.
				;
				; if they must control the return state, then they should also be implemented
				; in the normal handler, having been assigned a view window first.
				;--------------------------------------
				switch event/action [
					;----
					;-        -UNFOCUS ALL ( 'unfocus with no marble setup )
					UNFOCUS [
;						vprint "FOUND UNFOCUS EVENT"
						unless event/marble [
;							vprobe "NO MARBLE --- UNFOCUS ALL"
							
							;----
							; unfocus everything
							foreach item focused-marbles [
								; if we can't find the window, we still leave it in the list,
								; perhaps some other system is aware of the focused item.
								if window: search-parent-frames item 'window [
									window: last window
									queue-event clone-event/with event [
										action: 'unfocus  
										marble: item  
										view-window: window/view-face
									]
								]
							]
							none
						]
					]
				]

				unless event/view-window [
					if vout? [
						vout
					]
					return event
				]
				
				; check if the event's face is managed by a !window viewport, 
				rval: either viewport: get in event/view-window 'viewport [
					;vprint "This is a GLASS driven-window!"
					
					; this enables the viewport stream.
					; its also used to detect if the window is a VID or GLASS window
					event/viewport: event/view-window/viewport
					
					; uncomment for debugging 
					;unless event/action = 'time [probe event/action]
					
					
					
					;------------------------------------------------------
					;
					;           MAIN EVENT SWITCH
					;
					;------------------------------------------------------
					; note that events are ordererd in order of latency required
					; by those events.
					;
					; events with little or no interactivity should be at the end.
					;
					switch/default event/action [
						
						;----
						;-        -MOVE
						MOVE [
							;vprin "."
							; detect immobile mouse, to enable tool tips like system
							; needs fix doesn't really seem to work
							
							either event/coordinates = last-move-position [
								vprint "mouse is immobile!"
								
								either event/tick - immobile-start > 1000 [
									;print "tooltip visible"
									unless tooltip-marble [
										event/action: 'SHOW-TOOLTIP
										tooltip-marble: true
										event
									]
								][
									; consume useless event!
									none
								]
							
							][
								; ignore this freakish event
								unless event/coordinates = 32767x32767 [
									last-move-position: event/coordinates
									immobile-start: event/tick
									event/action: 'POINTER-MOVE
									tooltip-marble: false
									
									; add delta coordinates for easier handling of relative mouse moves
									if last-down-event [
										event: make event [
											drag-delta: (event/coordinates - last-down-event/coordinates)
											drag-start: last-down-event/coordinates
										]
									]
									event
								]
							]
						]
						

						;----
						;-        -KEY
						KEY [
							
							case [
								;--------------------------
								; hot keys (ctrl command)
								(all [
									event/control?
									find hot-keys event/key 
								])
								
								[
									event/action: 'HOT-KEY
								]
							
							
								;--------------------------
								; focused typing
								(not empty? focused-marbles) 
								
								[
									event/action: 'TEXT-ENTRY
								
								]
								
								
								;--------------------------
								; *raw typing.
								'default
								
								[
									event/action: 'RAW-KEY
								]
								
							]
							
							; re-spawn the event so appropriate key handlers pick up
							queue-event event
							none
						]							
							
						
													
						;----
						;-        -TEXT-ENTRY
						;
						TEXT-ENTRY [
							; convert common key combinations into commands.
							compound-key-code: any [
								all [ event/control? event/shift? join "ctrl+shift+" event/key ]
								all [ event/shift? join "shift+" event/key]
								all [ event/control? join "ctrl+" event/key]
							]
							
							event/key: any [
								select character-map-table compound-key-code 
								select character-map-table event/key 
								event/key
							]
							
							
							; this is a special event, which bypases normal dispatching!!
							foreach marble focused-marbles [
								event/marble: marble
								foreach handler marble/stream [
									handler event
								]
							]
							none
						]
						
						
						;----
						;-        -RAW-KEY
						;
						RAW-KEY [
							;vprint ["raw-key: " event/key]
							event
						]
						

						;----
						;-        -MARBLE-TEXT-ENTRY
						;
						;
						; special case... same as text-entry, but sends it back to marble which initiated it,
						; it doesn't use the focus list.
						;
						; note that event MUST have a marble associated to it.
						;
						; also note that the window will see the event, when it won't see normal text-entry events.
						MARBLE-TEXT-ENTRY [
							; convert common key combinations into commands.
							compound-key-code: any [
								all [ event/control? event/shift? compound-key-code: join "ctrl+shift+" event/key ]
								all [ event/shift? join "shift+" event/key]
								all [ event/control? join "ctrl+" event/key]
							]
							
							event/key: any [
								select character-map-table compound-key-code 
								select character-map-table event/key 
								event/key
							]
;							; this is a special event, which bypases normal dispatching!!
;							foreach marble focused-marbles [
;								event/marble: marble
;								foreach handler marble/stream [
;									handler event
;								]
;							]
							event
						]
						
						
						;----
						;-        -SCROLL-LINE SCROLL-PAGE
						; there is no point in forcing CTRL+scroll to be scroll-page.
						; individual marbles should decide that for themselves. 
						;
						; this is why we merge these two events into a single event.
						;
						; just check if CTRL is pressed anyways.
						;
						; this event will usually be consumed by windows, changed to 'SCROLL set the marble
						; and be requeued so we can generate focused-scroll variant.
						SCROLL-LINE SCROLL-PAGE [
							;vprint "SCROLLING!"
							
							event: make event [
								action: 'SCROLL-LINE
								amount: absolute coordinates/y
								direction: either coordinates/y > 0 [
									'pull
								][
									'push
								]
								;v?? last-move-position
								coordinates: last-move-position ; we need to know WHERE the scrolling occured.
							]
							
							event
						]
						
						
						;----
						;-        -SCROLL
						SCROLL [
							; we check if scrolled marble is focused or not
							if event/marble [
								if find focused-marbles event/marble [
									event/action: 'FOCUSED-SCROLL
								]
							]
							event
						]
					
						


						;----
						;-        -TIME
						TIME [
							;probe now/time/precise
							;probe event/tick
							;probe event/viewport/refresh-interval
						
							;prin [".  " event/tick ":" event/viewport/next-refresh]
							;vprint "REFRESH?"
							either all [
								event/tick > event/viewport/next-refresh
								any [
									event/viewport/glob/dirty?
									all [object? event/viewport/overlay event/viewport/overlay/dirty?]
								]
							][
								event/action: 'REFRESH
								event/viewport/next-refresh: event/tick + event/viewport/refresh-interval
								event
							][
								; timer isn't used ... don't stream further than this.
								none
							]
						]
						
						
						;----
						;-        -FOCUS
						FOCUS [
							;print "--------------FOCUS--------------"
							if event/marble [
								;vprint "MARBLE"
								either event/control? [
									;vprobe "control pressed!"
									unless find focused-marbles event/marble [
										append focused-marbles event/marble
									]
								][
									;vprint "NO CTRL"
									; unfocus everything
									foreach item focused-marbles [
										;vprint "UNFOCUSSING A MARBLE"
										queue-event clone-event/with event [action: 'unfocus marble: item]
									]
									append focused-marbles event/marble
									;vprint "ADDED FOCUSED MARBLE"
								]
							]
							event
						]
						
						
						;----
						;-        -UNFOCUS
						UNFOCUS [
							if event/marble [
								if marble: find focused-marbles event/marble [
									remove marble
								]
								event
							]
						]
						
						
						;----
						;-        -CLOSE
						CLOSE [
							event/action: 'CLOSE-WINDOW
							event
						]
						

						;----
						;-        -DOWN
						DOWN [
							vprint "MOUSE DOWN"
							; add the fast-click counter to all down-based events
							event: make event [fast-clicks: none]
							
							; remember, IF return none on failure
							fast-clicks?: if last-click + fast-click-delay > event/tick [
								event/fast-clicks: 1 + any [fast-clicks? 0]
							]
							
							event/action: 'POINTER-PRESS
							
							last-click: event/tick
							last-down-event: event
							
							event
						]
						
						
						;----
						;-        -UP
						UP [
							vprint "MOUSE UP"
							
							event/action: 'POINTER-RELEASE
							; add delta on release.
							if last-down-event [
								event: make event [
									drag-delta: (event/coordinates - last-down-event/coordinates)
									drag-start: last-down-event/coordinates
								]
								last-down-event: none
							]
							event
						]
						
						
						;----
						;-        -ALT-DOWN
						ALT-DOWN [
						
							; note there are no multi-clicks on context button clicks
							vprint "ALT mouse down"
							
							event/action: 'CONTEXT-PRESS
							event
						]
						
						
						;----
						;-        -ALT-UP
						ALT-UP [
						
							; note there are no multi-clicks on context button clicks
							vprint "ALT mouse down"
							
							event/action: 'CONTEXT-RELEASE
							event
						]
						


						
						;----
						;-        -ACTIVE
						ACTIVE [
							vprint ["GLASS WINDOW ACTIVATED: " event/view-window/text]
							event/action: 'WINDOW-ACTIVATED
							none
						]
						
						
						;----
						;-        -INACTIVE
						INACTIVE [
							vprint ["GLASS WINDOW DE-ACTIVATED: " event/view-window/text]
							event/action: 'WINDOW-DEACTIVATED
							none
						]
						
						
						;----
						;-        -OFFSET
						OFFSET [
							event/action: 'WINDOW-POSITION
							event
						]
						


						;----
						;-        -RESIZE
						RESIZE [
							vprint "window resize!"
							; fix coordinates of resize
							; the resizing mechanism is REALLY screwed-up in view
							; its very easy to create an endless feedback loop.
							event/coordinates: event/viewport/view-face/size
							event/action: 'WINDOW-RESIZED
							event
						]
						

												
						
					
					][
						vprint ["CORE unhandled: " event/action]
						event
					]
					
				][
					vprint "CORE HANDLER: NO VIEWPORT IN EVENT, NOT A GLASS EVENT"
					event
				]
				
				if vout? [
					vout
				]
				
				rval
			]
		]
	]
	;ask "DEFAULT HANDLERS ADDED"

]
	

	


	


;------------------------------------
; We are done testing this library.
;------------------------------------
;
; test-exit-slim
;
;------------------------------------