Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Heart animation for Red (only). Now with a complete control panel to play with the animations parameters. Nice time eater ;-)
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 "Snapchot" [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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment