Bouncing demo - Source Code

Script demonstrating the possibilities of Rebol's compositing engine.
Author: Cyphre
File size: 2K
Return to index

REBOL [
    title: "bouncing demo"
    author: cyphre@seznam.cz
]

site: http://www.rebol.net/plugin/demos/bouncing-demo
scr-size: 640x480

boing: does [make face [
    st-oft: offset: random scr-size
    al: random 255
    alx: (random 10) + 10
    edge: none
    color: none
    image: load-thru/binary rejoin [site "/" 0 random 8 ".png"]
    size: image/size
    down?: true
    effect: compose [key 0.255.0 alphamul (al)]
    rate: 0
    fp: false
    speed: random 6x1
    mass: (random 70000) + 30000
    feel: make feel [
        engage: func [f a e][
            bound: f/parent-face/size - f/size
            if e/type = 'time [
                al: al + alx
                if any [al > 255 al < 0] [f/alx: negate f/alx]
                dist: max (f/parent-face/size/y - f/offset/y) * 1.5 1
                grav:  to-integer (f/mass / (dist * dist))
                either f/down? [
                    tmp-y: f/offset/y + f/speed/y + grav
                ][
                    tmp-y: (f/offset/y + f/speed/y) - grav
                    if all [grav < 1 f/offset/y < f/st-oft/y] [f/speed/y: 1 f/down?: true]
                ]
                if tmp-y > bound/y [f/speed/y: -1 tmp-y: bound/y f/down?: false]
                if tmp-y < 0 [f/speed/y: 1 tmp-y: 0 f/down?: true]
                if f/offset/x > bound/x [f/offset/x: bound/x f/speed: to-pair reduce [negate f/speed/x random 6] f/down?: true]
                if f/offset/x < 0 [f/offset/x: 0 f/speed: to-pair reduce [negate f/speed/x random 6] f/down?: true]
                effect: compose [key 0.255.0 alphamul (al)]
                f/offset: to-pair reduce [f/offset/x + speed/x  tmp-y]
                show f
            ]
        ]
    ]
]
]

reb: boing
reb/image: logo.gif
reb/size: reb/image/size

view lay: layout [
    origin 0x0
    b1: box scr-size black
    at(scr-size / 3 * 0x1 * 2)
    box scr-size - (scr-size / 3 * 0x1 * 2) with [
        image: to-image make face [
            edge: none
            size: scr-size - (scr-size / 3 * 0x1 * 2)
            effect: [gradient 0x1 0.0.0 126.0.126]
        ]
        feel: none
        effect: none
    ]
    at 0x0
    sensor scr-size with [
        feel: none
        pane: reduce join array/initial 30 'boing [reb]
    ]
]