Bezier `curve`-based tweening

bezier-tweens.red

Red [
	Author: "Toomas Vooglaid"
	Date: 2018-07-27
	Purpose: {Study of bezier-based tweens}
	File: %bezier-tweens.red
	Needs: 'View
]

down-flags: [down1? down2? down3? down4? b1-down? b3-down?] ;down?
clear-down-flags: does [set down-flags off]
any-down?: does [any down-flags]

clear-down-flags

in-circle-check: function [
	event
	circle [block!] "['circle <ctr> <rad>]"
	'down-flag [word!]
][
	ctr: circle/2 
	rad: circle/3
	if within? event/offset ctr - rad  to pair! rad * 2 [set down-flag yes]
]
;down?: none 
;down1?: none 
;down2?: none 
;down3?: none 
;down4?: none 
tick: 0 
prg: 0
last-y: 400
last-x: 0
height: none

;system/view/auto-sync?: off

view lay: layout/flags/options [
	text "Duration:" 50x24
	_dur: field "200" 50x24 
	text "Rate:" 30x24
	_rate: field "64" 50x24
	button "Go" [
		tick: 0
		bz: draw as-pair 200 _box/size/y reduce [
			'anti-alias 'off 'curve _curve/2 - 100x0 _curve/3 - 100x0 _curve/4 - 100x0 _curve/5 - 100x0
		]
		last-y: _ctrl1/2/y
		y-points: collect [
			repeat x _dur/data [
				x: round/to x * (200.0 / _dur/data) 1
				repeat y _box/size/y [
					either 0.0.0.0 = pick bz as-pair x y [
						either last-y >= y [
							last-y: y
							keep y - 1
							break
						][
							last-y: y
							last-x: x
						]
					][
						case [
							all [x = last-x y - 1 = last-y][
								keep last-y - 1
								break
							]
							y = _box/size/y [keep none]
						]
					]
				]
			]
		]
		if _copy/data [write-clipboard mold y-points]
		time-step: 200.0 / _dur/data 
		_idx-start: _idx/2/y
		_drw/rate: _rate/data
	] 
	button "Stop" [_drw/rate: none]
	_copy: check "Copy"
	
	;#### Drawing box
	at 0x0 _drw: box 500x500 draw [
		pen silver 
		_time: line 100x299 100x100 
		pen black 
		_t1: text 50x88 ""
		_b1: box 100x100 299x299
		pen gray 
		_ctrl1: line 100x299 100x150
		_ctrl2: line 299x100 150x100
		pen blue 
		line-width 2 
		_curve: curve 100x299 100x150 150x100 299x100 
		line-width 1 
		pen black 
		fill-pen red 
		_circle1: circle 100x150 4
		_circle2: circle 150x100 4
		fill-pen leaf
		_circle3: circle 299x100 4
		fill-pen gold
		_circle4: circle 100x299 4
	] on-down [
		case [
			in-circle-check event _circle4 down4? []
			in-circle-check event _circle3 down3? []
			in-circle-check event _circle2 down2? []
			in-circle-check event _circle1 down1? []
;			within? event/offset _circle4/2 - 4 8x8 [down4?: yes] ;down?: 
;			within? event/offset _circle3/2 - 4 8x8 [down3?: yes] ;down?: 
;			within? event/offset _circle2/2 - 4 8x8 [down2?: yes] ;down?: 
;			within? event/offset _circle1/2 - 4 8x8 [down1?: yes] ;down?: 
			within? event/offset _b1/2 - 0x2 as-pair _b1/3/x - _b1/2/x 5 [
				b1-down?: yes ;down?:
				ofs: event/offset/y 
				height: _b1/3/y - _b1/2/y
			]
			within? event/offset (as-pair _b1/2/x _b1/3/y - 2) as-pair _b1/3/x - _b1/2/x 5 [
				b3-down?: yes ;down?:
				ofs: event/offset/y
				elements: copy [_time]
				if (as-pair _b1/2/x _b1/3/y) = _circle4/2 [append elements [_circle4 _ctrl1]]
				if _b1/3 = _circle3/2 [append elements [_circle3 _ctrl2]]
			]
		]
	] on-up [
		clear-down-flags
		_t1/3: ""
	] all-over on-over [
		if any-down? [
			either all [
				event/offset/x >= 100 event/offset/x <= 299
			][
				case [
					down1? [_circle1/2: _ctrl1/3: _curve/3: event/offset]
					down2? [_circle2/2: _ctrl2/3: _curve/4: event/offset]
					down3? [_circle3/2: _ctrl2/2: _curve/5: event/offset]
					down4? [
						_circle4/2: _ctrl1/2: _curve/2: event/offset 
						_idx/2/y: event/offset/y - 5 
						_t1/3: form _circle4/2/y
					]
					b1-down? [
						delta: event/offset/y - ofs 
						ofs: event/offset/y
						_t1/3: form event/offset/y 
						_t1/2/y: -8 + _b1/2/y: event/offset/y  
						_b1/3/y: _b1/2/y + height
						foreach element [_circle1 _circle2 _circle3 _circle4 _idx _time _ctrl1 _ctrl2 _curve][
							element: get element
							element/2/y: element/2/y + delta
						]
						foreach element [_time _ctrl1 _ctrl2 _curve][
							element: get element
							element/3/y: element/3/y + delta
						]
						_curve/4/y: _curve/4/y + delta 
						_curve/5/y: _curve/5/y + delta
					]
					b3-down? [
						_t1/3: form event/offset/y 
						_t1/2/y: -8 + _b1/3/y: event/offset/y
						delta: event/offset/y - ofs 
						ofs: event/offset/y
						foreach element elements [
							switch element [
								_circle4 [
									_idx/2/y: -5 + _curve/2/y: _curve/2/y + delta
								]
								_circle3 [
									_curve/5/y: _curve/5/y + delta
								]
							]
							element: get element
							element/2/y: element/2/y + delta
						]
					]
				]
			][
				case [
					down1? [
						_circle1/2: _ctrl1/3: _curve/3: either event/offset/x < 100 [
							as-pair 100 event/offset/y
						][
							as-pair 299 event/offset/y
						]
					]
					down2? [
						_circle2/2: _ctrl2/3: _curve/4: either event/offset/x < 100 [
							as-pair 100 event/offset/y
						][
							as-pair 299 event/offset/y
						]
					]
					down3? [
						_circle3/2: _ctrl2/2: _curve/5: either event/offset/x < 100 [
							as-pair 100 event/offset/y
						][
							as-pair 299 event/offset/y
						]
					]
					down4? [
						_idx/2/y: event/offset/y - 5
						_circle4/2: _ctrl1/2: _curve/2: either event/offset/x < 100 [
							as-pair 100 event/offset/y
						][
							as-pair 299 event/offset/y
						]
					]
				]
			]
		]
	] on-time [
		either _dur/data >= (tick: tick + 1) [
			_time/2/x: _time/3/x: to-integer (tick * time-step) + 100
			if pick y-points tick [_idx/2/y: 95 - 100 + pick y-points tick]
			;show _drw
		][
			face/rate: none
		]
	]
	
	;#### Indicator
	at 305x0 _box: box 20x400 draw [
		fill-pen red 
		_idx: translate 0x295 shape [line 0x5 5x0 15x0 15x10 5x10]
	]
]
; view flags
[resize]
; view options
[
	actors: object [
		on-resize: func [face event][
			_drw/size: lay/size
			_box/size/y: lay/size/y
		]
	]
]
;do-events

Just a couple refactoring tinkerings so far.