Vince's Corner Takeout

[vince]

Chaotic Scattering

demo of the Gaspard-Rice system:  https://en.wikipedia.org/wiki/Chaotic_scattering

left click to reposition laser
mouse wheel to change radius of reflectors

Code: (Select All)

deflng a-z

sw = 800
sh = 600

dim shared pi as double
pi = 4*atn(1)

dim as double t, a, b, a1, a2
dim as double x, y, x0, y0, x1, y1, dx, dy

r = 150
rr0 = 110

sx = 0
sy = sh/2

screen _newimage(sw, sh, 32)

do
        do while _mouseinput
                mw = mw + _mousewheel
        loop

        mx = _mousex
        my = _mousey
        mb = _mousebutton(1)

        rr = rr0 - mw

        if mb then
                do while mb
                        do while _mouseinput
                        loop
                        mb = _mousebutton(1)
                loop

                valid = -1
                for b = 0 to 2*pi step 2*pi/3
                        x1 = r*cos(b) + sw/2
                        y1 = r*sin(b) + sh/2

                        dx = mx - x1
                        dy = my - y1
                        if dx*dx + dy*dy < rr*rr then
                                valid = 0
                                exit for
                        end if
                next

                if valid then
                        sx = mx
                        sy = my
                end if
        end if

        if mx<>old_mx or my<>old_my or mw<>old_mw then
                line (0,0)-(sw,sh), _rgb(0,0,0), bf

                'locate 1,1
                '? mx, my, mw, mb

                for b = 0 to 2*pi step 2*pi/3
                        circle (r*cos(b) + sw/2, r*sin(b) + sh/2), rr
                next

                a = _atan2(my - sy, mx - sx)

                x0 = sx
                y0 = sy

                for t = 0 to 1000
                        x = t*cos(a) + x0
                        y = t*sin(a) + y0

                        for b = 0 to 2*pi step 2*pi/3
                                if x >= 0 and x < sw and y >=0 and y < sh then
                                        x1 = r*cos(b) + sw/2
                                        y1 = r*sin(b) + sh/2

                                        dx = x - x1
                                        dy = y - y1
                                        if dx*dx + dy*dy < rr*rr then
                                                a1 = _atan2(dy, dx)
                                                a2 = 2*a1 - a - pi

                                                line (x0, y0)-(x, y), _rgb(233,205,89)

                                                x0 = x
                                                y0 = y
                                                a = a2
                                                t = 0
                                                exit for
                                        end if
                                end if
                        next
                next

                line (x0, y0)-(x, y), _rgb(233,205,89)

        end if

        old_mx = mx
        old_my = my
        old_mw = mw

        _display
        _limit 50
loop until _keyhit = 27
system