Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Heart animation for Red (only). New parameters added to the (reordered) control panel to play with the animation + credits. Nice time eater ;-)
Red [
title: "Heart animation"
author: "Didier Cadieu"
notes: {
Traduction in Red 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
show-fps?: no
with-alpha?: yes
time-delta: 0.02
trace-offset: 0.4
target-scale: 1.5
clear-speed: 16
min-length: 10
spring-force: 0.7
spring-speed: 5.0
; 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
sparks-count: heart-points-count: length? points-origin
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: 148.0.0.196 + random 107.135.0.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: random 1.0
q: random heart-points-count
D: 2 * (i // 2) - 1
force: 0.0 + 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: 1
while [i <= sparks-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: square-root dx * dx + (dy * dy)
if min-length > 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 [
; print u/q: u/q + heart-points-count
;]
]
]
u/vx: u/vx - (u/speed + spring-speed * dx / length)
u/vy: u/vy - (u/speed + spring-speed * dy / length)
u/trace/1/1: u/trace/1/1 + u/vx
u/trace/1/2: u/trace/1/2 + u/vy
u/vx: u/force + spring-force * u/vx
u/vy: u/force + spring-force * u/vy
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 already pondered by alpha value.
]
]
i: i + 1
]
if sparks-count = 0 [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
main: 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 2x2 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
style txt2: label 396x15
style link: base left black font-size 8 font-color yello 396x13 [print face/text]
base " Control panel" black 84x18 font-color gray draw [rotate 0 6x9 fill-pen gray polygon 0x5 12x5 6x13] [
probe cp/parent/size
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
probe cp/parent/size
] 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 "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 "Sparks count" f-sc: cval data sparks-count sld on-create [face/data: 1.0 * sparks-count / heart-points-count] [f-sc/data: sparks-count: to-integer heart-points-count * face/data show f-sc] 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 "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 "Min length" f-ml: cval data min-length sld on-create [face/data: min-length / 30.0] [f-ml/data: min-length: to-integer face/data * 30 show f-ml] return
label "Spring force" f-sp: cval data spring-force sld data spring-force [f-sp/data: spring-force: face/data show f-sp] return
label "Spring speed" f-ss: cval data spring-speed sld on-create [face/data: spring-speed / 10.0] [f-ss/data: spring-speed: face/data * 10 show f-ss] 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] return
below space 0x0
txt2 "Author: Didier Cadieu"
txt2 "Credits: Terebus Volodymyr for the original Javacript code:"
link "http://codepen.io/tvolodimir/pen/wqKuJ"
txt2 "Learn more at:"
link "https://martijnbrekelmans.com/generative-art/heart-deconstruction/techniques.html"
] on-create [face/extra: face/size/y + (face/size/y: 18)]
]
; resize the window to hide the control panel at launch
main/size/y: cp/offset/y + 18
view/flags/no-wait main 'resize
; 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
@tvolodimir

This comment has been minimized.

Copy link

tvolodimir commented Jan 30, 2017

Wow. My codepen' heart here) How to run your script? Or can I have binary for windows

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.