|
|
|
Rebol universe - Source CodeFlight thru the Rebol code universe.... |
|
REBOL [
title: "Rebol universe by Cyphre in 2004"
author: cyphre@seznam.cz
]
rot: 0
stars: copy []
screen: 400x400
center: screen / 2
rng: 15
strange: fwd: false
objects: 2500
wrds: copy []
loop objects [
x: (random rng) - (rng / 2)
if x = 0 [x: (random rng) - (rng / 2)]
append stars reduce [x random 360 (random 255) + 1]
append wrds form first random first system/words
]
sort/skip/compare stars 3 3
stars-orig: copy stars
circle-grad: func [
size
col-a
col-b
/local result c-inc col cl siz
][
siz: size/x / 2
result: copy []
c-inc: reduce [col-a/1 - col-b/1 / siz col-a/2 - col-b/2 / siz col-a/3 - col-b/3 / siz]
cl: reduce [col-a/1 col-a/2 col-a/3]
repeat n siz [
col: to-tuple reduce [to-integer cl/1 to-integer cl/2 to-integer cl/3]
insert tail result compose [pen (col) fill-pen (col) circle (size / 2) (siz - n)]
cl: reduce [cl/1 - c-inc/1 cl/2 - c-inc/2 cl/3 - c-inc/3]
]
return result
]
view layout [
origin 0
img: image screen with [
image: to-image make face [
edge: none
size: screen
color: black
effect: compose/deep [draw [(circle-grad screen black sky * 1.2)]]
]
rate: 0
effect: [draw [] draw []]
font: make font [
size: 11
]
feel: make feel [
engage: func [f a e /local tmp col gx gy idx][
if e/type = 'time [
idx: 0
f/effect/2: copy []
f/effect/4: copy []
either fwd [
rot: rot + 4
][
rot: rot - 4
]
f/effect/2: compose [pen sky line-pattern 3 5 line]
foreach [x y z] stars [
idx: idx + 3
idx-x: idx - 2
idx-y: idx - 1
idx-w: idx / 3
if z < 10 [
gx: x * 256 / z + center/x
gy: y * 256 / z + center/y
tmp: min 255 to-integer 300 * 7 / z
col: to-tuple reduce [tmp tmp tmp]
append f/effect/2 (as-pair gx gy)
append f/effect/4 compose [pen (col) fill-pen (col) circle (as-pair gx gy) (to-integer 10 / z) font (make font [size: to-integer 50 / z]) text (as-pair gx gy) (wrds/:idx-w)]
]
either fwd [
z: z - 0.1
if z <= 1 [
z: 256
]
][
z: z + 0.1
if z > 256 [
z: 1
]
]
either strange [
poke stars idx-x stars-orig/:idx-x + y * sine rot + stars-orig/:idx-y
poke stars idx-y stars-orig/:idx-x + x * cosine rot + stars-orig/:idx-y
][
poke stars idx-x stars-orig/:idx-x * sine rot + stars-orig/:idx-y
poke stars idx-y stars-orig/:idx-x * cosine rot + stars-orig/:idx-y
]
poke stars idx z
]
if (rot // 250) = 0 [
fwd: first random [#[true] #[false]]
strange: first random [#[true] #[false]]
]
show f
]
]
]
]
at as-pair center/x - (logo.gif/size/x / 2) center/y - (logo.gif/size/y / 2)
image logo.gif with [feel: none]
]
|
