First try of an animation dialect for Red VID. Computation is not precise enough, but just a proof of concept ;-)

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