DideC · February 26, 2018 08:32
diff --git a/animate.red b/animate.red
 Red [
 	Purpose: "Animation system for VID"
 	Needs: 'View

 	Notes: {
 		Simplyfied Ease in/out formulas : http://gizma.com/easing/#l
 		See at the end of page source for javascripts formulas (included elastic) : http://easings.net/en
 	}
 ]

 ;system/view/debug?: yes
 live?: system/view/auto-sync?: no

 animator: context [
 	;--- Face use to handle the timing of animations
 	anim-face: none

 	;--- Default values
 	config: [
 		rate: 50				; rate of the animation
 		duration: 0:0:1			; default animation duration
 		curve: 'ease			; default curve function
 		at-the-end: initial	; default final state : let like it is at the end
 	]

 	;--- Animations to play for defined events
 	triggers: [
 		; Format is :
 		;	event [
 		;		face1 [[anim1]...[animN]] ... faceN [[anim1] ... [animN]]
 		;	]
 		; Where 'faceX is the face object! to animate and 'animX is like :
 		;
 	]

 	;--- Typesets for parsing
 	symbolS!: make typeset! [word! path!]
 	valueS!: make typeset! [integer! float! pair! tuple! word! path!]
 	pairS!: make typeset! [pair! word! path!]
 	floatS!: make typeset! [float! word! path!]
 	tupleS!: make typeset! [tuple! block! word! path!]
 	integerS!: make typeset! [integer! word! path!]
 	durationS!: make typeset! [float! integer! time! word! path!]
 	positionS!: make typeset! [integer! block! word! path!]

 	;--- Utility functions
 	fetch-value: function [
 		"Return the value or, if it's a word or path, get the value of."
 		value
 	] [
 		any [all [any [word? :value path? :value] attempt [get :value]] value]
 	]

 	;--- Initialize the animations data for a face
 	define-anim: func [
 		"Define the animation for a face."
 		_face [object!] "Face to animate."
 		desc [block!] "What to animate in Animate dialect."
 		/local l c errc type! _event _what _origin _target _amount _duration _trigger must-break? obj _curve _at-the-end _p1 _p2
 	] [
 		;--- Default curve is linear
 		must-break?: func [value [any-type!]] [
 			if all [none? errc  any [word? value  path? value]] [errc: c]
 		]

 		parse desc [
 			some [
 				l:
 				;--- Reset config values
 				(_origin: _target: _amount: _p1: _p2: none _duration: config/duration _at-the-end: config/at-the-end _curve: select curves config/curve _debug: false)

 				;--- Event to animate
 				'on c: set _event ['over | 'down | 'up | 'key | 'enter | 'change | 'time | 'focus | 'unfocus | 'click |skip (must-break? 'yes)] (
 					; Select or create the list of faces to animate for this event
 					trigger: select any [find triggers _event  append triggers reduce [_event copy []]] _event
 				)
 				;--- Property to animate (define the type of value to provide for)
 				opt 'set c: set _what [
 					'size (type!: pairS!)
 					| 'offset (type!: pairS!)
 					| 'color (type!: tupleS!)
 					| 'draw (type!: valueS!) set _p1 positionS! (must-break? _p1: fetch-value _p1) opt [set _p2 integer!]
 				]
 				;--- Define the start value (if not, it's the current one), the target value or the amount to add to the start value
 				some [
 					'from c: set _origin type! (must-break? _origin: fetch-value _origin)
 					| 'to c: set _target type! (must-break? _target: fetch-value _target)
 					| 'add c: set _amount type! (must-break? _amount: fetch-value _amount)
 				]
 				;--- Duration of the animation (optionnal)
 				opt [
 					'in c: set _duration durationS! (if number? _duration: fetch-value _duration [_duration: 0:0 + _duration] must-break? _duration)
 				]
 				opt [
 					'effect c: set _curve word! (_curve: select curves _curve if none? :_curve [must-break? 'yes])
 				]
 				opt [
 					'then c: set _at-the-end ['initial | 'final | 'invert | 'reset | skip (must-break? 'yes) ]
 				]
 				opt ['debug (_debug: true)]
 				;--- Everything is defined : control and store the values
 				(
 					either none? errc [
 						; pick or create the block of animation objects for this face
 						trigger: select any [find trigger _face   append trigger reduce [_face copy []]] _face
 						; Build the animation object
 						obj: make proto-anim [
 							event: _event
 							face: _face
 							property: _what
 							curve: :_curve
 							debug?: _debug
 							; Store the values needed to start animation
 							defaults: compose/only copy [origin: (detuplify _origin) target: (detuplify _target) amount: (detuplify _amount) duration: (_duration) at-the-end: (_at-the-end)]
 							; choose the function used to compute and play the animation
 							play: either any [tuple? _origin tuple? _target tuple? _amount] [:play-tuple] [:play-other]
 							if _what = 'draw [
 								in-draw?: true
 								; Set property to the position in the draw block of the value to animate
 								property: either integer? _p1 [at face/draw _p1][at _p1 any [_p2 1]]
 							]
 						]
 						obj/init
 						; Add it to the animation list
 						append trigger obj

 						;print ["Animate: on " _event ", set " _what " from " _origin " to " _target ", or add " _amount ", in " _duration]
 						;? triggers
 					] [
 						print ["Invalid ANIMATOR value at:" copy/part l errc rejoin [">>> " copy/part errc 1 " <<<"] copy/part next errc 3 either 4 < length? errc ["(...)"][""]]
 					]
 				)
 				;--- If we goes here there is an error in the syntax
 				| to 'on (print ["Invalid ANIMATOR command near:" copy/part l c rejoin [">>> " copy/part c 1 " <<<"] copy/part next c 3 either 4 < length? c ["(...)"][""]])
 			]
 		]
 	]
 	set 'animate :define-anim

 	detuplify: func [
 		"If the value is a tuple!, return a block of each values, else return the value"
 		val
 		/local b
 	] [
 		either tuple? val [
 			b: copy []
 			repeat n length? val [append b val/:n]
 			b
 		] [val]
 	]

 	;--- Queue of currently played animation
 	anim-queue: [
 	]

 	start-animation: func [
 		"Add the animation to the animation queue."
 		anim [object!] "The animation to start playing"
 	] [
 ;		probe anim
 		; Add it to the animation queue
 		if not find anim-queue anim [
 			; Initialize the animation
 			anim/play/begin
 			append anim-queue anim
 		]
 	]

 	stop-animation: func [
 		"Remove the animation object from the animation queue."
 		anim [object!]
 		/finalize "Finalize the animation (last step)"
 	] [
 		if finalize [anim/step: 1.0 anim/play]
 		if anim: find anim-queue anim [remove anim]
 	]

 	;--- Bezier function to compute curve values (return the y value of the point in a 0.0 to 1.0 default scale)
 	bezier3y: func [
 		"Compute the y value of the bezier curve"
 		t [float!] "Progression on the curve from 0.0 to 1.0"
 		p1 [pair!] p2 [pair!] p3 [pair!] p4 [pair!] "Control points of the cubic Bezier curve"
 		size [pair!] "Size of the control points space. Used to reduce to 0.0 to 1.0 scale"
 		/local t1 a b c d
 	] [
 		t1: 1.0 - t
 		a: t1 ** 3
 		b: t1 ** 2 * t * 3
 		c: t ** 2 * t1 * 3
 		d: t ** 3
 		t1: a * p1/y + (b * p2/y) + (c * p3/y) + (d * p4/y) / size/y
 ;		print ["t=" t " y=" t1]
 ;		t1
 	]
 	;--- Bezier function to compute ease values (return the x value of the point in a 0.0 to 1.0 default scale
 	bezier3x: func [
 		"Compute the y value of the bezier curve"
 		t [float!] "Progression on the curve from 0.0 to 1.0"
 		p1 [float!] p2 [float!] p3 [float!] p4 [float!] "Control value of the cubic Bezier curve in x axis. Space is 0.0 to 1.0."
 		/local t1 a b c d
 	] [
 		t1: 1.0 - t
 		a: t1 ** 3
 		b: t1 ** 2 * t * 3
 		c: t ** 2 * t1 * 3
 		d: t ** 3
 		t1: a * p1 + (b * p2) + (c * p3) + (d * p4)
 ;		print ["t=" t " x=" t1]
 ;		t1
 	]

 	;--- Available curves functions
 	curves: reduce [
 		'linear			func [x [float!]] [max 0.0 min 1.0 x]
 		'sinus			func [x [float!]] [sin pi * x]
 		'cosinus		func [x [float!]] [cos pi * x - pi / 2]
 		'ease			func [x [float!]] [bezier3x x 0.0  0.1  1.0   1.0]
 		'easein			func [x [float!]] [bezier3x x 0.0  0.42 1.0   1.0]
 		'easeout		func [x [float!]] [bezier3x x 0.0  0.0  0.58  1.0]
 		'easeinout		func [x [float!]] [bezier3x x 0.0  0.42 0.58  1.0]
 		'easeinback		func [x [float!]] [bezier3x x 0.0 -0.28 0.74 1.0] ;0.6, -0.28, 0.735, 0.045
 		'easeoutback	func [x [float!]] [bezier3x x 0.0  0.26 1.28 1.0] ;0.6, -0.28, 0.735, 0.045
 		'easeinoutback	func [x [float!]] [bezier3x x 0.0 -0.28 1.28 1.0] ;0.6, -0.28, 0.735, 0.045
 ;		'ease func [x [float!]] [bezier3y x 0x0 10x25 100x25 100x100 100x100]
 ;		'easein func [x [float!]] [bezier3y x 0x0 42x0 100x100 100x100 100x100]
 ;		'easeout func [x [float!]] [bezier3y x 0x0 0x0 58x100 100x100 100x100]
 ;		'easeinout func [x [float!]] [bezier3y x 0x0 42x0 58x100 100x100 100x100]
 	]

 	do-operator-on: func [
 		"Apply an operator for each value of v1 and v2"
 		v1 op v2 /local res t
 	] [
 		either block? v1 [
 			res: copy []
 			repeat n length? v1 [append res min 255 to integer! do reduce [v1/:n :op any [all [block? v2 v2/:n] v2]]]
 			res
 		] [
 			v1 :op v2
 		]
 	]

 	;--- Prototype of the animation object for a face
 	proto-anim: make object! [
 		defaults: 		; Block of initial values for the animation (origin, target, amount & duration)
 		event:			; Event that trigerred the animation
 		face:			; Face to animate
 		property: 		; Property to change value
 		start:			; Start value
 		diff:			; Difference between start end end value
 		previous: none	; Previous value
 		step: 0.0		; Current step (from 0.0 to 1.0)
 		inc: 0.0333333	; Increment to next step
 		debug?: false	; True to output animation values
 		;--- Function that compute the output multiplicator for a step
 		curve: 			; Function that compute the curve value (from 0.0 to 1.0)
 		play: none		; Function to call for this property
 		in-draw?: false	; false : animate a property of the face / true : animate a value in the draw block
 		;--- Function that animate the face
 		; tuple member value can not be negative, so we can't store tuple as tuple, but block
 		play-tuple: func [
 			"Compute the new tuple value for the property to animate"
 			/begin
 			/local current
 		] [
 			either begin [
 				;--- Sets the value to change
 				start: any [defaults/origin  detuplify either in-draw? [reduce first property][get in face property]  detuplify white]
 				diff: any [defaults/amount  do-operator-on defaults/target '- start]
 				end: any [defaults/target  do-operator-on start '+ diff]
 				current: make tuple! start
 				;--- Sets the steps values
 				step: 0.0
 				if debug? [print ["BEGIN  start:" start "diff:" diff "current:" current "step:" step defaults]]
 			] [
 				step: step + inc
 				;--- (pair! * float!) not allowed (but why does it works for tuple! then ?)
 				current: make tuple! do-operator-on start '+ (do-operator-on diff '* (curve step))
 				if debug? [print ["       start:" start "diff:" diff "current:" current "step:" step defaults]]
 			]
 			; all steps has occured
 			if step > 1.0 [
 				stop-animation self
 				switch/default defaults/at-the-end [
 					initial [current: make tuple! start]
 					final [current: make tuple! end]
 					reset [if none? defaults/origin [default/origin: either block? start [copy start][detuplify start]]]
 					invert []
 				][print ["ANIMATOR: at the end value (" defaults/at-the-end ") is not of the right type:" type? defaults/at-the-end]]
 				if debug? [print ["FINISH start:" start "diff:" diff "current:" current "step:" step defaults]]
 			]
 			if previous = current [exit]	; same value than the last step : no need to animate
 			previous: current
 			either in-draw? [change property current] [set in face property current]
 			if all [face/visible?  not system/view/auto-sync?] [show face]
 		]

 		play-other: func [
 			"Compute the new value for the property to animate"
 			/begin
 			/local current
 		] [
 			either begin [
 				;--- Sets the value to change
 				start: any [defaults/origin  either in-draw? [first property][get in face property]]
 				diff: any [defaults/amount  defaults/target - start]
 				end: any [defaults/target  start + diff]
 				current: start
 				;--- Sets the steps values
 				step: 0.0
 				if debug? [print ["BEGIN  start:" start "diff:" diff "current:" current "step:" step defaults]]
 			] [
 				step: step + inc
 				current: curve step
 				;--- (pair! * float!) not allowed (but why does it works for tuple! then ?)
 				either pair? diff [
 					current: start + as-pair diff/x * current diff/y * current
 				] [
 					current: diff * current + start
 				]
 				if debug? [print ["       start:" start "diff:" diff "current:" current "step:" step defaults]]
 			]
 			; all steps has occured
 			if step >= 1.0 [
 				stop-animation self
 				switch defaults/at-the-end [
 					initial [current: start]
 					final [current: end]
 					reset [if none? defaults/origin [defaults/origin: start]]
 					invert [start: end diff: negate diff]
 				]
 				if debug? [print ["FINISH start:" start "diff:" diff "current:" current "step:" step defaults]]
 			]
 			if previous = current [exit]	; same value than the last step : no need to animate
 			previous: current
 			either in-draw? [change property current face/draw] [set in face property current]
 			if all [face/visible?  not system/view/auto-sync?] [show face]
 		]

 		init: func [
 			"Initialise the animation"
 			/local d r
 		] [
 			; compute the number of animation steps rendered by second
 			if time? r: config/rate [r: 1 / r/second]
 			; compute the duration of the animation in seconds
 			if time? d: defaults/duration [d: d/hour * 60 + d/minute * 60 + d/second]
 			; inc is the increment to go from 0 to 1 in the number of rendered steps needed for this animation
 			inc: 1 / (d * r)
 		]
 	]

 	;-- Global events filter
 	event-handler: insert-event-func function [face event /local b a event-type] [
 		all [
 			;-- 'away event is an 'over event with event/away? = true : give it its own existence
 			event-type: any [all [event/type = 'over  event/away? 'away] event/type]

 			b: select triggers event-type
 			b: select b face
 ;			either all [event/type = 'over  event/away?] [
 ;				foreach a b [stop-animation/finalize a]
 ;			] [
 				foreach a b [start-animation a]
 ;			]
 		]
 		none
 	]

 	initialize: func [
 		"Initialise the animator."
 		face [object!] "Face use to handle the timimg of animations."
 	] [
 		; init the face
 		anim-face: face
 		anim-face/rate: config/rate
 	]

 	play-animation: has [anim] [
 		foreach anim anim-queue [anim/play]
 	]
 ]

 q: :quit

 ease-time: 1.5
 trans-amount: 220x0
 font1: make font! [name: "Calibri"]

 view [
 	;--- Definition of the animator face
 	base 0x0 on-create [animator/initialize face] on-time [animator/play-animation]

 	field "Didier" on-create [
 		animate face [on time set color to red in 0.5 effect sinus]
 ;		animate face [on over set size add 20x20 in 0.5]
 ;		animate face [on over set offset add -10x-10 in 0.25]
 ;		animate face [on time set offset add 10x15 in 1.0]
 	] rate 0:0:5 ;on-click [probe face/actors]
 	button "Halt" [q: :halt unview]
 	button "Probe triggers" [probe animator/triggers]
 	return
 	base 300x300 draw [
 		font font1
 		fill-pen blue t1: translate 0x0 [box 0x0 40x20] text 0x0 "Ease"
 		fill-pen green t2: translate 0x25 [box 0x0 40x20] text 0x25 "Ease-in"
 		fill-pen red t3: translate 0x50 [box 0x0 40x20]	text 0x50 "Ease-out"
 		fill-pen yellow t4: translate 0x75 [box 0x0 40x20]	text 0x75 "Ease-in-out"
 		fill-pen navy t5: translate 0x100 [box 0x0 40x20] text 0x100 "Linear"
 		fill-pen magenta t6: translate 0x125 [box 0x0 40x20] text 0x125 "Sinus"
 		fill-pen gold t7: translate 0x150 [box 0x0 40x20] text 0x150 "Ease-in-back"
 		fill-pen purple t8: translate 0x175 [box 0x0 40x20] text 0x175 "Ease-out-back"
 		fill-pen gray t9: translate 0x200 [box 0x0 40x20] text 0x200 "Ease-in-out-back"
 	] on-create [
 		animate face [on over set draw t1 2 add trans-amount in ease-time effect ease then reset]
 		animate face [on over set draw t2 2 add trans-amount in ease-time effect easein then reset]
 		animate face [on over set draw t3 2 add trans-amount in ease-time effect easeout then reset]
 		animate face [on over set draw t4 2 add trans-amount in ease-time effect easeinout then reset]
 		animate face [on over set draw t5 2 add trans-amount in ease-time effect linear then reset]
 		animate face [on over set draw t6 2 add trans-amount in ease-time effect sinus then reset]
 		animate face [on over set draw t7 2 add trans-amount in ease-time effect easeinback then reset]
 		animate face [on over set draw t8 2 add trans-amount in ease-time effect easeoutback then reset]
 		animate face [on over set draw t9 2 add trans-amount in ease-time effect easeinoutback then reset]
 ;		animate face [on over set draw 2 to red in 0.5]
 		;animate face [on over set draw 7 to red in 0.5 effect linear]
 	]
 	base "test" 80x20 draw [pen blue fill-pen cyan box 0x0 0x20] on-create [
 		animate face [on over set draw 7 to 80x20 in 0.2 then reset]
 	]
 ]
 q
	Red [
	Purpose: "Animation system for VID"
	Needs: 'View

	Notes: {
	Simplyfied Ease in/out formulas : http://gizma.com/easing/#l
	See at the end of page source for javascripts formulas (included elastic) : http://easings.net/en
	}
	]

	;system/view/debug?: yes
	live?: system/view/auto-sync?: no

	animator: context [
	;--- Face use to handle the timing of animations
	anim-face: none

	;--- Default values
	config: [
	rate: 50 ; rate of the animation
	duration: 0:0:1 ; default animation duration
	curve: 'ease ; default curve function
	at-the-end: initial ; default final state : let like it is at the end
	]

	;--- Animations to play for defined events
	triggers: [
	; Format is :
	; event [
	; face1 [[anim1]...[animN]] ... faceN [[anim1] ... [animN]]
	; ]
	; Where 'faceX is the face object! to animate and 'animX is like :
	;
	]

	;--- Typesets for parsing
	symbolS!: make typeset! [word! path!]
	valueS!: make typeset! [integer! float! pair! tuple! word! path!]
	pairS!: make typeset! [pair! word! path!]
	floatS!: make typeset! [float! word! path!]
	tupleS!: make typeset! [tuple! block! word! path!]
	integerS!: make typeset! [integer! word! path!]
	durationS!: make typeset! [float! integer! time! word! path!]
	positionS!: make typeset! [integer! block! word! path!]

	;--- Utility functions
	fetch-value: function [
	"Return the value or, if it's a word or path, get the value of."
	value
	] [
	any [all [any [word? :value path? :value] attempt [get :value]] value]
	]

	;--- Initialize the animations data for a face
	define-anim: func [
	"Define the animation for a face."
	_face [object!] "Face to animate."
	desc [block!] "What to animate in Animate dialect."
	/local l c errc type! _event _what _origin _target _amount _duration _trigger must-break? obj _curve _at-the-end _p1 _p2
	] [
	;--- Default curve is linear
	must-break?: func [value [any-type!]] [
	if all [none? errc any [word? value path? value]] [errc: c]
	]

	parse desc [
	some [
	l:
	;--- Reset config values
	(_origin: _target: _amount: _p1: _p2: none _duration: config/duration _at-the-end: config/at-the-end _curve: select curves config/curve _debug: false)

	;--- Event to animate
	'on c: set _event ['over \| 'down \| 'up \| 'key \| 'enter \| 'change \| 'time \| 'focus \| 'unfocus \| 'click \|skip (must-break? 'yes)] (
	; Select or create the list of faces to animate for this event
	trigger: select any [find triggers _event append triggers reduce [_event copy []]] _event
	)
	;--- Property to animate (define the type of value to provide for)
	opt 'set c: set _what [
	'size (type!: pairS!)
	\| 'offset (type!: pairS!)
	\| 'color (type!: tupleS!)
	\| 'draw (type!: valueS!) set _p1 positionS! (must-break? _p1: fetch-value _p1) opt [set _p2 integer!]
	]
	;--- Define the start value (if not, it's the current one), the target value or the amount to add to the start value
	some [
	'from c: set _origin type! (must-break? _origin: fetch-value _origin)
	\| 'to c: set _target type! (must-break? _target: fetch-value _target)
	\| 'add c: set _amount type! (must-break? _amount: fetch-value _amount)
	]
	;--- Duration of the animation (optionnal)
	opt [
	'in c: set _duration durationS! (if number? _duration: fetch-value _duration [_duration: 0:0 + _duration] must-break? _duration)
	]
	opt [
	'effect c: set _curve word! (_curve: select curves _curve if none? :_curve [must-break? 'yes])
	]
	opt [
	'then c: set _at-the-end ['initial \| 'final \| 'invert \| 'reset \| skip (must-break? 'yes) ]
	]
	opt ['debug (_debug: true)]
	;--- Everything is defined : control and store the values
	(
	either none? errc [
	; pick or create the block of animation objects for this face
	trigger: select any [find trigger _face append trigger reduce [_face copy []]] _face
	; Build the animation object
	obj: make proto-anim [
	event: _event
	face: _face
	property: _what
	curve: :_curve
	debug?: _debug
	; Store the values needed to start animation
	defaults: compose/only copy [origin: (detuplify _origin) target: (detuplify _target) amount: (detuplify _amount) duration: (_duration) at-the-end: (_at-the-end)]
	; choose the function used to compute and play the animation
	play: either any [tuple? _origin tuple? _target tuple? _amount] [:play-tuple] [:play-other]
	if _what = 'draw [
	in-draw?: true
	; Set property to the position in the draw block of the value to animate
	property: either integer? _p1 [at face/draw _p1][at _p1 any [_p2 1]]
	]
	]
	obj/init
	; Add it to the animation list
	append trigger obj

	;print ["Animate: on " _event ", set " _what " from " _origin " to " _target ", or add " _amount ", in " _duration]
	;? triggers
	] [
	print ["Invalid ANIMATOR value at:" copy/part l errc rejoin [">>> " copy/part errc 1 " <<<"] copy/part next errc 3 either 4 < length? errc ["(...)"][""]]
	]
	)
	;--- If we goes here there is an error in the syntax
	\| to 'on (print ["Invalid ANIMATOR command near:" copy/part l c rejoin [">>> " copy/part c 1 " <<<"] copy/part next c 3 either 4 < length? c ["(...)"][""]])
	]
	]
	]
	set 'animate :define-anim

	detuplify: func [
	"If the value is a tuple!, return a block of each values, else return the value"
	val
	/local b
	] [
	either tuple? val [
	b: copy []
	repeat n length? val [append b val/:n]
	b
	] [val]
	]

	;--- Queue of currently played animation
	anim-queue: [
	]

	start-animation: func [
	"Add the animation to the animation queue."
	anim [object!] "The animation to start playing"
	] [
	; probe anim
	; Add it to the animation queue
	if not find anim-queue anim [
	; Initialize the animation
	anim/play/begin
	append anim-queue anim
	]
	]

	stop-animation: func [
	"Remove the animation object from the animation queue."
	anim [object!]
	/finalize "Finalize the animation (last step)"
	] [
	if finalize [anim/step: 1.0 anim/play]
	if anim: find anim-queue anim [remove anim]
	]

	;--- Bezier function to compute curve values (return the y value of the point in a 0.0 to 1.0 default scale)
	bezier3y: func [
	"Compute the y value of the bezier curve"
	t [float!] "Progression on the curve from 0.0 to 1.0"
	p1 [pair!] p2 [pair!] p3 [pair!] p4 [pair!] "Control points of the cubic Bezier curve"
	size [pair!] "Size of the control points space. Used to reduce to 0.0 to 1.0 scale"
	/local t1 a b c d
	] [
	t1: 1.0 - t
	a: t1 ** 3
	b: t1 ** 2 * t * 3
	c: t ** 2 * t1 * 3
	d: t ** 3
	t1: a * p1/y + (b * p2/y) + (c * p3/y) + (d * p4/y) / size/y
	; print ["t=" t " y=" t1]
	; t1
	]
	;--- Bezier function to compute ease values (return the x value of the point in a 0.0 to 1.0 default scale
	bezier3x: func [
	"Compute the y value of the bezier curve"
	t [float!] "Progression on the curve from 0.0 to 1.0"
	p1 [float!] p2 [float!] p3 [float!] p4 [float!] "Control value of the cubic Bezier curve in x axis. Space is 0.0 to 1.0."
	/local t1 a b c d
	] [
	t1: 1.0 - t
	a: t1 ** 3
	b: t1 ** 2 * t * 3
	c: t ** 2 * t1 * 3
	d: t ** 3
	t1: a * p1 + (b * p2) + (c * p3) + (d * p4)
	; print ["t=" t " x=" t1]
	; t1
	]

	;--- Available curves functions
	curves: reduce [
	'linear func [x [float!]] [max 0.0 min 1.0 x]
	'sinus func [x [float!]] [sin pi * x]
	'cosinus func [x [float!]] [cos pi * x - pi / 2]
	'ease func [x [float!]] [bezier3x x 0.0 0.1 1.0 1.0]
	'easein func [x [float!]] [bezier3x x 0.0 0.42 1.0 1.0]
	'easeout func [x [float!]] [bezier3x x 0.0 0.0 0.58 1.0]
	'easeinout func [x [float!]] [bezier3x x 0.0 0.42 0.58 1.0]
	'easeinback func [x [float!]] [bezier3x x 0.0 -0.28 0.74 1.0] ;0.6, -0.28, 0.735, 0.045
	'easeoutback func [x [float!]] [bezier3x x 0.0 0.26 1.28 1.0] ;0.6, -0.28, 0.735, 0.045
	'easeinoutback func [x [float!]] [bezier3x x 0.0 -0.28 1.28 1.0] ;0.6, -0.28, 0.735, 0.045
	; 'ease func [x [float!]] [bezier3y x 0x0 10x25 100x25 100x100 100x100]
	; 'easein func [x [float!]] [bezier3y x 0x0 42x0 100x100 100x100 100x100]
	; 'easeout func [x [float!]] [bezier3y x 0x0 0x0 58x100 100x100 100x100]
	; 'easeinout func [x [float!]] [bezier3y x 0x0 42x0 58x100 100x100 100x100]
	]

	do-operator-on: func [
	"Apply an operator for each value of v1 and v2"
	v1 op v2 /local res t
	] [
	either block? v1 [
	res: copy []
	repeat n length? v1 [append res min 255 to integer! do reduce [v1/:n :op any [all [block? v2 v2/:n] v2]]]
	res
	] [
	v1 :op v2
	]
	]

	;--- Prototype of the animation object for a face
	proto-anim: make object! [
	defaults: ; Block of initial values for the animation (origin, target, amount & duration)
	event: ; Event that trigerred the animation
	face: ; Face to animate
	property: ; Property to change value
	start: ; Start value
	diff: ; Difference between start end end value
	previous: none ; Previous value
	step: 0.0 ; Current step (from 0.0 to 1.0)
	inc: 0.0333333 ; Increment to next step
	debug?: false ; True to output animation values
	;--- Function that compute the output multiplicator for a step
	curve: ; Function that compute the curve value (from 0.0 to 1.0)
	play: none ; Function to call for this property
	in-draw?: false ; false : animate a property of the face / true : animate a value in the draw block
	;--- Function that animate the face
	; tuple member value can not be negative, so we can't store tuple as tuple, but block
	play-tuple: func [
	"Compute the new tuple value for the property to animate"
	/begin
	/local current
	] [
	either begin [
	;--- Sets the value to change
	start: any [defaults/origin detuplify either in-draw? [reduce first property][get in face property] detuplify white]
	diff: any [defaults/amount do-operator-on defaults/target '- start]
	end: any [defaults/target do-operator-on start '+ diff]
	current: make tuple! start
	;--- Sets the steps values
	step: 0.0
	if debug? [print ["BEGIN start:" start "diff:" diff "current:" current "step:" step defaults]]
	] [
	step: step + inc
	;--- (pair! * float!) not allowed (but why does it works for tuple! then ?)
	current: make tuple! do-operator-on start '+ (do-operator-on diff '* (curve step))
	if debug? [print [" start:" start "diff:" diff "current:" current "step:" step defaults]]
	]
	; all steps has occured
	if step > 1.0 [
	stop-animation self
	switch/default defaults/at-the-end [
	initial [current: make tuple! start]
	final [current: make tuple! end]
	reset [if none? defaults/origin [default/origin: either block? start [copy start][detuplify start]]]
	invert []
	][print ["ANIMATOR: at the end value (" defaults/at-the-end ") is not of the right type:" type? defaults/at-the-end]]
	if debug? [print ["FINISH start:" start "diff:" diff "current:" current "step:" step defaults]]
	]
	if previous = current [exit] ; same value than the last step : no need to animate
	previous: current
	either in-draw? [change property current] [set in face property current]
	if all [face/visible? not system/view/auto-sync?] [show face]
	]

	play-other: func [
	"Compute the new value for the property to animate"
	/begin
	/local current
	] [
	either begin [
	;--- Sets the value to change
	start: any [defaults/origin either in-draw? [first property][get in face property]]
	diff: any [defaults/amount defaults/target - start]
	end: any [defaults/target start + diff]
	current: start
	;--- Sets the steps values
	step: 0.0
	if debug? [print ["BEGIN start:" start "diff:" diff "current:" current "step:" step defaults]]
	] [
	step: step + inc
	current: curve step
	;--- (pair! * float!) not allowed (but why does it works for tuple! then ?)
	either pair? diff [
	current: start + as-pair diff/x * current diff/y * current
	] [
	current: diff * current + start
	]
	if debug? [print [" start:" start "diff:" diff "current:" current "step:" step defaults]]
	]
	; all steps has occured
	if step >= 1.0 [
	stop-animation self
	switch defaults/at-the-end [
	initial [current: start]
	final [current: end]
	reset [if none? defaults/origin [defaults/origin: start]]
	invert [start: end diff: negate diff]
	]
	if debug? [print ["FINISH start:" start "diff:" diff "current:" current "step:" step defaults]]
	]
	if previous = current [exit] ; same value than the last step : no need to animate
	previous: current
	either in-draw? [change property current face/draw] [set in face property current]
	if all [face/visible? not system/view/auto-sync?] [show face]
	]

	init: func [
	"Initialise the animation"
	/local d r
	] [
	; compute the number of animation steps rendered by second
	if time? r: config/rate [r: 1 / r/second]
	; compute the duration of the animation in seconds
	if time? d: defaults/duration [d: d/hour * 60 + d/minute * 60 + d/second]
	; inc is the increment to go from 0 to 1 in the number of rendered steps needed for this animation
	inc: 1 / (d * r)
	]
	]

	;-- Global events filter
	event-handler: insert-event-func function [face event /local b a event-type] [
	all [
	;-- 'away event is an 'over event with event/away? = true : give it its own existence
	event-type: any [all [event/type = 'over event/away? 'away] event/type]

	b: select triggers event-type
	b: select b face
	; either all [event/type = 'over event/away?] [
	; foreach a b [stop-animation/finalize a]
	; ] [
	foreach a b [start-animation a]
	; ]
	]
	none
	]

	initialize: func [
	"Initialise the animator."
	face [object!] "Face use to handle the timimg of animations."
	] [
	; init the face
	anim-face: face
	anim-face/rate: config/rate
	]

	play-animation: has [anim] [
	foreach anim anim-queue [anim/play]
	]
	]

	q: :quit

	ease-time: 1.5
	trans-amount: 220x0
	font1: make font! [name: "Calibri"]

	view [
	;--- Definition of the animator face
	base 0x0 on-create [animator/initialize face] on-time [animator/play-animation]

	field "Didier" on-create [
	animate face [on time set color to red in 0.5 effect sinus]
	; animate face [on over set size add 20x20 in 0.5]
	; animate face [on over set offset add -10x-10 in 0.25]
	; animate face [on time set offset add 10x15 in 1.0]
	] rate 0:0:5 ;on-click [probe face/actors]
	button "Halt" [q: :halt unview]
	button "Probe triggers" [probe animator/triggers]
	return
	base 300x300 draw [
	font font1
	fill-pen blue t1: translate 0x0 [box 0x0 40x20] text 0x0 "Ease"
	fill-pen green t2: translate 0x25 [box 0x0 40x20] text 0x25 "Ease-in"
	fill-pen red t3: translate 0x50 [box 0x0 40x20] text 0x50 "Ease-out"
	fill-pen yellow t4: translate 0x75 [box 0x0 40x20] text 0x75 "Ease-in-out"
	fill-pen navy t5: translate 0x100 [box 0x0 40x20] text 0x100 "Linear"
	fill-pen magenta t6: translate 0x125 [box 0x0 40x20] text 0x125 "Sinus"
	fill-pen gold t7: translate 0x150 [box 0x0 40x20] text 0x150 "Ease-in-back"
	fill-pen purple t8: translate 0x175 [box 0x0 40x20] text 0x175 "Ease-out-back"
	fill-pen gray t9: translate 0x200 [box 0x0 40x20] text 0x200 "Ease-in-out-back"
	] on-create [
	animate face [on over set draw t1 2 add trans-amount in ease-time effect ease then reset]
	animate face [on over set draw t2 2 add trans-amount in ease-time effect easein then reset]
	animate face [on over set draw t3 2 add trans-amount in ease-time effect easeout then reset]
	animate face [on over set draw t4 2 add trans-amount in ease-time effect easeinout then reset]
	animate face [on over set draw t5 2 add trans-amount in ease-time effect linear then reset]
	animate face [on over set draw t6 2 add trans-amount in ease-time effect sinus then reset]
	animate face [on over set draw t7 2 add trans-amount in ease-time effect easeinback then reset]
	animate face [on over set draw t8 2 add trans-amount in ease-time effect easeoutback then reset]
	animate face [on over set draw t9 2 add trans-amount in ease-time effect easeinoutback then reset]
	; animate face [on over set draw 2 to red in 0.5]
	;animate face [on over set draw 7 to red in 0.5 effect linear]
	]
	base "test" 80x20 draw [pen blue fill-pen cyan box 0x0 0x20] on-create [
	animate face [on over set draw 7 to 80x20 in 0.2 then reset]
	]
	]
	q