Heart animation for Red (only). Now with a complete control panel to play with the animations parameters. Nice time eater ;-)

heart-animation.red

Red [
	title: "Heart animation"
	author: "Didier Cadieu"
	notes: {
		Traduction in Red/Rebol of Terebus Volodymyr javascript demo : http://codepen.io/tvolodimir/pen/wqKuJ
	}
	Needs: View
]

;*** Settings
bkg-color: 0.0.0.255
b-size: 400x400
v-rate: 30
target-scale: 1.0
show-fps?: no
with-alpha?: yes
time-delta: 0.02
trace-offset: 0.7
target-scale: 1.5
clear-speed: 16

; Quick or slow animation
quick?: false
trace-count: either quick? [20] [50]
dr: either quick? [0.3] [0.1]

;*** Init
img: none		; for compilation to not error out
canvas: make image! reduce [b-size bkg-color]

;*** Functions to comptue the heart form points
heart-position: func [rad] [
;	reduce [sin rad  cos rad]
	reduce [power sin rad 3  negate (15 * cos rad) - (5 * cos 2 * rad) - (2 * cos 3 * rad) - cos 4 * rad]
]
scale-and-translate: func [pos sx sy dx dy] [
	reduce [dx + pos/1 * sx  dy + pos/2 * sy]
]

build-points: func [sx sy dx dy /local i tau] [
	tau: pi * 2
	i: 0.0
	while [i <= tau] [
		append/only points-origin scale-and-translate heart-position i sx sy dx dy
		i: i + dr
	]
]

points-origin: []

build-points 210 13 0 -2
build-points 150 9 0 -2
build-points 90 5 0 -2

target-length: heart-points-count: length? points-origin
target-count: 0

target-points: copy/deep points-origin

do set-clearing: does [
	clearing: compose clear-code: [fill-pen (bkg-color - (0.0.0.1 * clear-speed)) box -1x-1 (canvas/size)]
]

pulse: func [kx ky] [
	repeat i length? points-origin [
		target-points/:i/1: kx * points-origin/:i/1 + canvas/size/x / 2
		target-points/:i/2: ky * points-origin/:i/2 + canvas/size/y / 2
	]
]

give-color: func [obj type /local c] [
	switch type [
		1 [
			c: 128.0.0.196 + random 127.75.75.0
			c/3: c/2
		]
		2 [c: random 255.255.255.96]
	]
	if not with-alpha? [c/4: 255]
	obj/f: c
	obj/a: 1.0 * c/4 / 255	; alpha of the color
	obj/oma: 1.0 - obj/a	; complemented alpha
	obj/f: c * obj/a		; "weigth" of the pixel color regarding alpha value
	obj/f/4: 0				; alpha already used
]

sparks: []
repeat i heart-points-count [
	point: reduce [random 1.0 * canvas/size/x random 1.0 * canvas/size/y]
	append sparks context [
		vx: vy: 0
		R: 2
		speed: 5.0 + random 1.0
		q: random heart-points-count
		D: 2 * (i // 2) - 1
		force: 0.7 + random 0.2

		f: a: oma: none
		give-color self 1

		trace: copy []
		loop trace-count [append/only trace copy point]
	]
]

time: 0.0

draw-sparks: has [n n2 i u q dx dy length] [
	t1: now/time/precise
	n: cos time
	n2: target-scale + n * 0.5
	pulse n2 n2
	time: time + (time-delta * any [all [0 > sin time  9.0] any [all [n > 0.8  0.2] 1.0]])

	draw canvas clearing

	i: length? sparks
	while [i > target-count] [
		u: pick sparks i
		q: pick target-points u/q
		dx: u/trace/1/1 - q/1
		dy: u/trace/1/2 - q/2
		length: sqrt dx * dx + (dy * dy)
		if 10 > length [
			either 95 < random 100 [
				u/q: random heart-points-count
			] [
				if 99 < random 100 [u/D: negate u/D]
				u/q: u/q + u/D
				u/q: u/q // heart-points-count + 1
				if 0 > u/q [
					u/q: u/q + heart-points-count
				]
			]
		]
		u/vx: u/vx - (dx / length * u/speed)
		u/vy: u/vy - (dy / length * u/speed)
		u/trace/1/1: u/trace/1/1 + u/vx
		u/trace/1/2: u/trace/1/2 + u/vy
		u/vx: u/vx * u/force
		u/vy: u/vy * u/force
		k: next u/trace
		forall k [
			n: k/-1
			n2: k/1
			n2/1: n2/1 - (n2/1 - n/1 * trace-offset)
			n2/2: n2/2 - (n2/2 - n/2 * trace-offset)
		]

		k: at u/trace (length? u/trace) - trace-count
		forall k [
			all [
				c: pick canvas point: to-pair k/1		; some points may be outside the image
				poke canvas point c * u/oma + u/f		; compute the new pixel color based on previous value and new one pondered by alpha value.
			]
		]
		i: i - 1
	]

;	poke canvas 1x1 pick canvas 1x1					; needed if comp? = off : no refesh without that (despite the clearing)

	show img

	; display max FPS in the top left corner
	if show-fps? [draw canvas reduce ['pen  200.200.200 'text 0x0 form 0.01 * to-integer to-float 100 / (now/time/precise - t1)]]
]

recolor: func [type] [
	foreach u sparks [give-color u type]
]

system/view/auto-sync?: no

img-tog: draw make image! 18x18 [polygon 1x1 18x1 9x18]

q: :quit
view/flags/no-wait layout [
	backdrop black
	title "Heart animation"
	origin 0x0 space 0x0 below
	img: image canvas rate v-rate on-time [draw-sparks]
	cp: panel [
		backdrop black
		origin 0x0 space 2x2

		style label: text black font-color white
		style cval: field black font-color white disabled 40
		style sld: slider black
		style btn: button 0x18

		base "    Control panel" black 84x18 font-color gray draw [rotate 0 6x9 fill-pen gray polygon 0x5 12x5 6x13] [
			face/draw/2: 180 - face/draw/2
			cp/size/y: cp/extra - cp/size/y
			cp/parent/size/y: cp/offset/y + cp/size/y
			show cp/parent
		] return
		label "Pulse speed" f-dt: cval data time-delta sld on-create [face/data: round/to time-delta * 5 0.001] [f-dt/data: round/to time-delta: max 0.001 face/data / 5 0.001 show f-dt] return
		label "Refresh speed" f-rs: cval data v-rate sld on-create [face/data: v-rate / 60.0] [f-rs/data: v-rate: to-integer 60 * face/data img/rate: all [v-rate > 0 v-rate] show [f-rs img]] return
		label "Trace count" f-tc: cval data trace-count sld on-create [face/data: trace-count / 50.0] [f-tc/data: trace-count: to-integer 50 * face/data show f-tc] return
		label "Trace offset" f-to: cval data trace-offset sld data trace-offset [f-to/data: trace-offset: face/data show f-to] return
		label "Trace colors" check "With alpha?" data with-alpha? [with-alpha?: face/data recolor f-dd/selected] black font-color white f-dd: drop-down data ["Only red" "Rainbow"] black font-color white select 1 on-change [recolor face/selected] return
		label "Target length" f-tl: cval data target-length sld on-create [face/data: 1.0 * target-length / heart-points-count] [f-tl/data: target-length: to-integer heart-points-count * face/data target-count: heart-points-count - target-length show f-tl] return
		label "Target scale" f-ts: cval data target-scale sld on-create [face/data: target-scale - 0.5 / 2] [f-ts/data: round/to target-scale: face/data * 2 + 0.5 0.1 target-scale show f-ts] return
		label "Clearing speed" f-cs: cval data clear-speed sld on-create [face/data: clear-speed / 255.0] [f-cs/data: clear-speed: to-integer face/data * 255 set-clearing show f-cs] return
		btn "Run?" [img/rate: either img/rate [none][v-rate] show img]
		btn "Max fps?" [show-fps?: not show-fps?]
		btn "Snapshot" [if file: request-file/save/title/file "Save the image to the disk" %heart.png [save file to-image img]]
		btn "halt" [q: :halt unview]
	] on-create [face/extra: face/size/y + 18 face/size/y: 18]
] 'resize

; resize the window to hide the control panel at launch
cp/parent/size/y: cp/offset/y + 18
show cp/parent

; This handle the resize of window content when it is resized
insert-event-func [
	if event/type = 'resize [
		cp/offset/y: cp/parent/size/y - cp/size/y
		img/size: img/parent/size - (0x1 * cp/size)
		show cp/parent
		'done
	]
]

do-events

q