Print Page - Garland of pearls

Title: Garland of pearls
Post by: MasterGy on March 21, 2022, 08:12:03 pm

in principle, if I create a cobweb of points and connections, it will be a real cobweb in 3d that takes over all the vibrations of the spider

Code: QB64: [Select]

 
RANDOMIZE TIMER
CONST pip180 = 3.141592 / 180
monx = 800: mony = 800: mon = _NEWIMAGE(monx, mony, 32): SCREEN mon
 
gravity = 1
obj_c = 15 'number objects
DIM obj(obj_c - 1, 9) '0,1 posX,Y 3fix/mover
 
 
 
cent_x = monx / 2: cent_y = 20: zoom = 2
 
'install "garland of pearls"
 
 
'garland
min_weight = 6
FOR a = 0 TO obj_c - 1
    obj(a, 0) = (RND(1) - .5) * 100
    obj(a, 1) = (RND(1) - .5) * 100
    obj(a, 2) = min_weight + min_weight / 2 * RND(1)
    obj(a, 3) = 1 '<---- 0 if fix, 1 if fly
 
NEXT a
obj(0, 0) = -64.5: obj(0, 1) = 5: obj(0, 3) = 0
obj(obj_c - 1, 0) = 183.5: obj(obj_c - 1, 1) = -.5: obj(obj_c - 1, 3) = 0
 
'connections
conn_c = 100: DIM conn(conn_c - 1, 4)
FOR a = 0 TO obj_c - 2
    conn(a, 0) = a
    conn(a, 1) = a + 1
    conn(a, 2) = 20 'rope width
    conn(a, 3) = 1
NEXT a
 
 
 
 
 
DO: _LIMIT 100
 
    'show info
    wch = -1: FOR a = 0 TO obj_c - 1
        IF _MOUSEX < 200 AND INT(_MOUSEY / 16) = a THEN wch = a: COLOR _RGB32(255, 255, 255) ELSE COLOR _RGB32(100, 100, 100)
        LOCATE a + 1, 1: PRINT a; "# weight:"; INT(obj(a, 2) * 10) / 10;: IF obj(a, 3) = 0 THEN PRINT "FIX";
        IF wch = a THEN PRINT "<--- using mousewheel !"
        IF wch <> -1 THEN obj(wch, 2) = obj(wch, 2) + mw / 10: IF obj(wch, 2) < min_weight THEN obj(wch, 2) = min_weight
    NEXT a
    LOCATE mony / 16 - 1, 1: IF moving THEN PRINT "press SPACE to FIX/FLY"; ELSE PRINT "grab the ball with the mouse and move it!";
 
    'draw objects
    FOR a = 0 TO obj_c - 1
        x = cent_x + obj(a, 0) * zoom
        y = cent_y + obj(a, 1) * zoom
        IF mouse_near = a THEN COLOR _RGB32(255, 0, 0) ELSE COLOR _RGB32(200, 200, 200)
        CIRCLE (x, y), obj(a, 2) * zoom
        _PRINTSTRING (x, y), LTRIM$(STR$(a))
    NEXT a
 
    'draw connections
 
    COLOR _RGB32(150, 150, 150)
    FOR a = 0 TO conn_c - 1: IF conn(a, 3) = 0 THEN _CONTINUE
        x1 = obj(conn(a, 0), 0) * zoom + cent_x
        y1 = obj(conn(a, 0), 1) * zoom + cent_y
        x2 = obj(conn(a, 1), 0) * zoom + cent_x
        y2 = obj(conn(a, 1), 1) * zoom + cent_y
    LINE (x1, y1)-(x2, y2): NEXT a
 
    'calculate moving
 
 
    FOR a = 0 TO obj_c - 1: IF obj(a, 3) = 0 OR (mouse_near = a AND _MOUSEBUTTON(1)) THEN _CONTINUE
 
        'connections vector
        vec_x = 0: vec_y = 0: vec_c = 0
        FOR t = 0 TO conn_c - 1: IF conn(t, 3) = 0 THEN _CONTINUE
            x = -1: FOR t2 = 0 TO 1: IF conn(t, t2) = a THEN x = conn(t, t2 XOR 1)
            NEXT t2
            IF x <> -1 THEN
                disx = obj(a, 0) - obj(x, 0)
                disy = obj(a, 1) - obj(x, 1)
                ang = (-degree(disx, disy) + 0) * pip180
                dis = SQR(disx * disx + disy * disy)
                power = dis / obj(a, 2) / 5
                '  IF dis < (obj(a, 2) + obj(x, 2)) THEN power = -power / 10000
                vec_x = vec_x + SIN(ang) * power
                vec_y = vec_y - COS(ang) * power
                vec_c = vec_c + 1
            END IF
        NEXT t
 
        gravity = .1
        lass = .98
 
        obj(a, 4) = (obj(a, 4) + vec_x / vec_c) * lass
        obj(a, 5) = (obj(a, 5) + vec_y / vec_c) * lass + gravity
 
        lx = obj(a, 0) + obj(a, 4)
        ly = obj(a, 1) + obj(a, 5)
 
        obj(a, 0) = obj(a, 0) + obj(a, 4)
        obj(a, 1) = obj(a, 1) + obj(a, 5)
 
 
 
    NEXT a
 
    mw = 0: WHILE _MOUSEINPUT: mw = mw + _MOUSEWHEEL: WEND
 
    'mouse moving activing
    IF moving = 0 THEN
        mouse_near = -1
        FOR a = 0 TO obj_c - 1
            disx = (cent_x + obj(a, 0) * zoom) - _MOUSEX
            disy = (cent_y + obj(a, 1) * zoom) - _MOUSEY
            dis = SQR(disx * disx + disy * disy)
            IF dis < 10 THEN mouse_near = a
        NEXT a
    END IF
 
    IF (_MOUSEBUTTON(1) AND mouse_near <> -1) OR moving THEN
        moving = 1
        obj(mouse_near, 0) = (_MOUSEX - cent_x) / zoom
        obj(mouse_near, 1) = (_MOUSEY - cent_y) / zoom
    END IF
 
    moving = moving AND _MOUSEBUTTON(1)
 
 
    'change weights with mousewheel
 
 
 
    _DISPLAY: CLS
 
    'commands
    inkey2$ = INKEY$: IF inkey2$ = CHR$(27) THEN END
    IF inkey2$ = " " AND _MOUSEBUTTON(1) AND moving THEN obj(mouse_near, 3) = obj(mouse_near, 3) XOR 1
 
 
LOOP
 
 
 
 
FUNCTION degree (a, b): degreex = ATN(a / (b + .00001)) / pip180: degreex = degreex - 180 * ABS(0 > b): degreex = degreex - 360 * (degreex < 0): degree = degreex: END FUNCTION
 

Title: Re: Garland of pearls
Post by: bplus on March 21, 2022, 08:23:10 pm

Wow nice effect!

Title: Re: Garland of pearls
Post by: Richard Frost on March 22, 2022, 04:03:28 am

Very interesting!

Strange that you do something so difficult yet manage to plot the instructions off the screen.

I added this after the SCREEN is declared:
_ScreenMove (_DesktopWidth - _Width) \ 2, 20

Title: Re: Garland of pearls
Post by: STxAxTIC on March 22, 2022, 06:07:00 am

This program is incredibly fun to play with. Thanks very much for sharing MasterGy! This could most likely be used to study standing wave motion in flexible chains, both transverse and longitudinal waves. You always manage to pack so much action into your programs, it's impressive.

I'm pretty sure your program solves a thing called the "elastic catenary", which might just be a stretched-out version of a hyperbolic cosine. I'm not positive on that though, something tells me no closed solution exists, but I haven't tried the math by hand myself. Oh boy, here we go... (just kidding) No need to do the actual math, you've already got the simulation on hand!

I like that you mention spider webs. I think I can see what you're about to do next and it's very exciting!

Title: Re: Garland of pearls
Post by: Dav on March 22, 2022, 09:34:14 am

This is pretty amazing, @MasterGy!

- Dav

Title: Re: Garland of pearls
Post by: MasterGy on March 22, 2022, 10:11:44 am

Thanks for the comments. I honestly admit, I myself am amazed that this works. In games, I long ago figured it out to display text, animate, move when I want change to be flexible. Let A and B. Let "A" be the current value. Let B be the new value. By definition B = A. But this makes it inflexible in timing, animation, positioning work.
Therefore, I usually do it so that not B = A, but B = B + (A-B) x "all", for example. "All" must be between 0 and 1! This will be a constant value. If 0, no offset occurs. If 1, an inelastic, immediate displacement occurs. On the other hand, if I write e.g.
The more times we perform it, the closer it gets to B = A. The larger the difference between A and B, the faster it makes the change, and when it is almost reached, it slows down. In fact, it never reaches.
Implementing STxAxTIC with the pendulum program returns the cleanest physics. Then came my idea of what it would be like to forget that much complicated physics and use the method described above to move the ball. Ball "B" wants to be in place of "A" ... B = B + (A-B) x "all"
In principle, since this seems to work, this method could also be used to move, collide without the use of rigid-body physics or any more serious mathematics. In theory. Pendulum, brick wall collapses by bricks, car overturns, precise collision of two bodies with rotations and directions. It seems as if this simple method bypasses the part of physics where pulse retention, angular velocity, vectors should be taken into account. The system simply extracts from itself.
I’m very curious as to how far this can go, and is the latter suggestion true? does it work
I described these so that if anyone cares and wants to deal with it, sees opportunities in it like I do, then see how simple it is. try it !
I set up the program to eliminate flexibility. From here, the things described above should work in principle.
The program starts and you can turn flexibility on and off with the "S" key. If we turn it off, we get approximately the pendulum motion of STxAxTIC. When turned on, it will be flexible as if they were connected with rubber.

Code: QB64: [Select]

RANDOMIZE TIMER
CONST pip180 = 3.141592 / 180
monx = 800: mony = 800: mon = _NEWIMAGE(monx, mony, 32): SCREEN mon
 
min_weight = 6
gravity = 1
obj_c = 10 'number objects
DIM obj(obj_c - 1, 9) '0,1 posX,Y 3fix/mover
cent_x = monx / 2: cent_y = mony * .2: zoom = 2
 
'garland
FOR a = 0 TO obj_c - 1
    obj(a, 0) = (RND(1) - .5) * 200
    obj(a, 1) = (RND(1) - .5) * 200
    obj(a, 2) = min_weight + min_weight / 2 * RND(1)
    obj(a, 3) = 1 '<---- 0 if fix, 1 if fly
    obj(a, 4) = 1 'active point
 
NEXT a
obj(0, 0) = -64.5: obj(0, 1) = 5: obj(0, 3) = 0
'obj(obj_c - 1, 0) = 183.5: obj(obj_c - 1, 1) = -.5: obj(obj_c - 1, 3) = 0
 
'connections
conn_c = 100: DIM conn(conn_c - 1, 4)
FOR a = 0 TO obj_c - 2
    conn(a, 0) = a
    conn(a, 1) = a + 1
    conn(a, 2) = 15 'rope width
    conn(a, 3) = 1 'active connect
NEXT a
 
 
 
stiff = 1
 
DO: _LIMIT 100
 
    'show info
    wch = -1: FOR a = 0 TO obj_c - 1
        IF _MOUSEX < 200 AND INT(_MOUSEY / 16) = a THEN wch = a: COLOR _RGB32(255, 255, 255) ELSE COLOR _RGB32(100, 100, 100)
        LOCATE a + 1, 1: PRINT a; "# weight:"; INT(obj(a, 2) * 10) / 10;: IF obj(a, 3) = 0 THEN PRINT "FIX";
        IF wch = a THEN PRINT "<--- using mousewheel !" 'change weights with mousewheel
        IF wch <> -1 THEN obj(wch, 2) = obj(wch, 2) + mw / 10: IF obj(wch, 2) < min_weight THEN obj(wch, 2) = min_weight
    NEXT a
    LOCATE mony / 16 - 2, 1
    IF moving THEN PRINT "press SPACE to FIX/FLY" ELSE PRINT "grab the ball with the mouse and move it!"
    PRINT "S-button - rigid / flexible connections";
    'draw objects
    FOR a = 0 TO obj_c - 1: IF obj(a, 4) = 0 THEN _CONTINUE
        x = cent_x + obj(a, 0) * zoom: y = cent_y + obj(a, 1) * zoom
        IF mouse_near = a THEN COLOR _RGB32(255, 0, 0) ELSE COLOR _RGB32(200, 200, 200)
        CIRCLE (x, y), obj(a, 2) * zoom: _PRINTSTRING (x, y), LTRIM$(STR$(a))
    NEXT a
 
    'draw connections
 
    COLOR _RGB32(150, 150, 150)
    FOR a = 0 TO conn_c - 1: IF conn(a, 3) = 0 THEN _CONTINUE
        IF obj(conn(a, 0), 4) = 0 OR obj(conn(a, 1), 4) = 0 THEN _CONTINUE
        x1 = obj(conn(a, 0), 0) * zoom + cent_x: y1 = obj(conn(a, 0), 1) * zoom + cent_y
        x2 = obj(conn(a, 1), 0) * zoom + cent_x: y2 = obj(conn(a, 1), 1) * zoom + cent_y
    LINE (x1, y1)-(x2, y2): NEXT a
 
 
 
    'calculate moving
    FOR a = 0 TO obj_c - 1: obj(a, 6) = obj(a, 0): obj(a, 7) = obj(a, 1)
        IF obj(a, 3) = 0 OR (mouse_near = a AND _MOUSEBUTTON(1)) OR obj(a, 4) = 0 THEN _CONTINUE
        'connections vector
        vec_x = 0: vec_y = 0: vec_c = 0
        FOR t = 0 TO conn_c - 1: IF conn(t, 3) = 0 THEN _CONTINUE
            x = -1: FOR t2 = 0 TO 1: IF conn(t, t2) = a THEN x = conn(t, t2 XOR 1)
            NEXT t2
            IF x <> -1 THEN
                IF obj(x, 4) THEN
                    disx = obj(a, 0) - obj(x, 0)
                    disy = obj(a, 1) - obj(x, 1)
                    ang = (-degree(disx, disy) + 0) * pip180
                    dis = SQR(disx * disx + disy * disy)
                    power = (dis - (obj(a, 2) + obj(x, 2) + conn(t, 2))) * 1 ' obj(a, 2) ^ 2 '/ 20
                    IF stiff THEN power = power / obj(a, 2) ^ 2 * 4
                    vec_x = vec_x + SIN(ang) * power
                    vec_y = vec_y - COS(ang) * power
                    vec_c = vec_c + 1
                END IF
            END IF
        NEXT t
 
        gravity = .1: lass = .98
        obj(a, 4) = (obj(a, 4) + vec_x / vec_c) * lass: obj(a, 5) = (obj(a, 5) + vec_y / vec_c) * lass + gravity
        obj(a, 6) = obj(a, 0) + obj(a, 4): obj(a, 7) = obj(a, 1) + obj(a, 5)
    NEXT a
    FOR a = 0 TO obj_c - 1: FOR t = 0 TO 1: obj(a, t) = obj(a, 6 + t): NEXT t, a
 
 
 
 
    'mouse moving activing
    mw = 0: WHILE _MOUSEINPUT: mw = mw + _MOUSEWHEEL: WEND
    IF moving = 0 THEN
        mouse_near = -1
        FOR a = 0 TO obj_c - 1
            disx = (cent_x + obj(a, 0) * zoom) - _MOUSEX
            disy = (cent_y + obj(a, 1) * zoom) - _MOUSEY
            dis = SQR(disx * disx + disy * disy)
            IF dis < 10 THEN mouse_near = a
        NEXT a
    END IF
 
    IF (_MOUSEBUTTON(1) AND mouse_near <> -1) OR moving THEN
        moving = 1
        obj(mouse_near, 0) = (_MOUSEX - cent_x) / zoom
        obj(mouse_near, 1) = (_MOUSEY - cent_y) / zoom
    END IF
 
    moving = moving AND _MOUSEBUTTON(1)
 
    stiff = stiff XOR ABS(inkey2$ = "s")
 
    _DISPLAY: CLS
 
    'commands
    inkey2$ = INKEY$: IF inkey2$ = CHR$(27) THEN END
    IF inkey2$ = " " AND _MOUSEBUTTON(1) AND moving THEN obj(mouse_near, 3) = obj(mouse_near, 3) XOR 1
 
 
LOOP
 
 
 
 
FUNCTION degree (a, b): degreex = ATN(a / (b + .00001)) / pip180: degreex = degreex - 180 * ABS(0 > b): degreex = degreex - 360 * (degreex < 0): degree = degreex: END FUNCTION
 
FUNCTION randx (x): randx = x * RND(1) - x / 2: END FUNCTION

Title: Re: Garland of pearls
Post by: MasterGy on March 22, 2022, 10:33:05 am

The trouble is, because of the translation, I can’t express myself the way I want to.
It doesn't matter what we measure. Distance, volume, size, speed, rotation, anything.
Quantity "A". This quantity wants to be "B".
Then use: B = B + (A-B) x "all"
This offers many opportunities.
I hope this thought, which I really want to go through, has gone through somewhat.
I wrote a simple illustration on it.

Code: QB64: [Select]

SCREEN _NEWIMAGE(800, 600, 32)
 
 
CHANGING = .05
'if CHANGING 0:no move
'if CHANGING 1:immediate displacement
'if CHANGING between 0,1 elastic displacement
 
 
DO
    _LIMIT 50
    WHILE _MOUSEINPUT: WEND
    x = x + (_MOUSEX - x) * CHANGING
    y = y + (_MOUSEY - y) * CHANGING
    _PRINTSTRING (x, y), "X"
    _DISPLAY
    CLS
LOOP
 

It shows movement. But the principle can be distance, volume, size, speed, rotation, anything ...

Title: Re: Garland of pearls
Post by: STxAxTIC on March 22, 2022, 10:52:40 am

Hey MasterGy,

I think I understand what you're saying. I use a similar piece of mathematics for mouse controls in my pendulum code:

(There may be a version of it floating around that shows a trail behind the mouse pointer.)

Code: QB64: [Select]

SUB RePin
    DIM AS DOUBLE n
    n = .05
    mx0 = n * mx + (1 - n) * mx0
    my0 = n * my + (1 - n) * my0
END SUB

Title: Re: Garland of pearls
Post by: MasterGy on March 22, 2022, 03:36:20 pm

grab the cobweb!

Code: QB64: [Select]

RANDOMIZE TIMER
CONST pip180 = 3.141592 / 180
monx = 800: mony = 800: mon = _NEWIMAGE(monx, mony, 32): SCREEN mon
 
min_weight = 6
gravity = 1
obj_c = 1000 'number objects
DIM obj(obj_c - 1, 9) '0,1 posX,Y 3fix/mover
cent_x = monx / 2: cent_y = mony / 2: zoom = 1.8
 
 
 
'cobweb
ag0 = 320 'size
ag1 = 18 'felbontas ag
ag2 = 14 'felbontas net
ag3 = ag0 * .18 / 2 'rad1
ag4 = ag0 * .9 / 2 'rad2
 
 
FOR t = 0 TO ag1 - 1
    ang = (360 / ag1 * t + randx(360 / ag1 * .3)) * pip180
    dis = ABS(ag3 - ag4)
    x1 = SIN(ang) * ag3 + randx(ag3 * .1)
    y1 = COS(ang) * ag3 + randx(ag3 * .1)
    x2 = SIN(ang) * ag4 + randx(ag4 * .2)
    y2 = COS(ang) * ag4 + randx(ag4 * .2)
 
    FOR t2 = 0 TO ag2 - 1
        aobj = t2 + ag2 * t
        obj(aobj, 0) = x1 + (x2 - x1) / (ag2 - 1) * t2
        obj(aobj, 1) = y1 + (y2 - y1) / (ag2 - 1) * t2
        obj(aobj, 2) = 1.9 'min_weight
        obj(aobj, 3) = 1
        '        IF t2 = ag2 - 1 THEN obj(aobj, 3) = 0
 
        obj(aobj, 4) = 1
    NEXT t2
NEXT t
 
 
'connections
conn_c = 1000: DIM conn(conn_c - 1, 4): ac = 0
 
FOR t = 0 TO ag2 - 2: FOR t2 = 0 TO ag1 - 1: conn(ac, 0) = t2 * ag2 + t: conn(ac, 1) = t2 * ag2 + ((t + 1) MOD ag2)
        conn(ac, 2) = SQR((obj(conn(ac, 0), 0) - obj(conn(ac, 1), 0)) ^ 2 + (obj(conn(ac, 0), 1) - obj(conn(ac, 1), 1)) ^ 2)
        conn(ac, 2) = conn(ac, 2) + randx(conn(ac, 2) * .1)
conn(ac, 3) = 1: ac = ac + 1: NEXT t2, t
 
FOR t = 0 TO ag2 - 1: FOR t2 = 0 TO ag1 - 1: conn(ac, 0) = t + ag2 * t2: conn(ac, 1) = t + ag2 * ((t2 + 1) MOD ag1)
        conn(ac, 2) = SQR((obj(conn(ac, 0), 0) - obj(conn(ac, 1), 0)) ^ 2 + (obj(conn(ac, 0), 1) - obj(conn(ac, 1), 1)) ^ 2)
        conn(ac, 2) = conn(ac, 2) + randx(conn(ac, 2) * .1)
conn(ac, 3) = 1: ac = ac + 1: NEXT t2, t
 
polar_p = ag1 * ag2
FOR t = 0 TO 3
    obj(polar_p + t, 0) = ((t AND 1) * 2 - 1) * ag0 / 2
    obj(polar_p + t, 1) = (SGN(t AND 2) * 2 - 1) * ag0 / 2
    obj(polar_p + t, 2) = 6 'min_weight
    obj(polar_p + t, 3) = 0
    obj(polar_p + t, 4) = 1
    mindis = 999999999
 
    FOR a = 0 TO polar_p - 1
        dis = SQR((obj(polar_p + t, 0) - obj(a, 0)) ^ 2 + (obj(polar_p + t, 1) - obj(a, 1)) ^ 2) * .8
        IF dis < mindis THEN mindis = dis: conn_n = a
    NEXT a
    conn(ac, 0) = polar_p + t
    conn(ac, 1) = conn_n
    conn(ac, 2) = mindis
    conn(ac, 3) = 1
    ac = ac + 1
 
NEXT t
 
 
 
 
 
stiff = 1
 
DO: _LIMIT 100
 
    'show info
    wch = -1: FOR a = 0 TO obj_c - 1
        IF _MOUSEX < 200 AND INT(_MOUSEY / 16) = a THEN wch = a: COLOR _RGB32(255, 255, 255) ELSE COLOR _RGB32(100, 100, 100)
        ' LOCATE a + 1, 1: PRINT a; "# weight:"; INT(obj(a, 2) * 10) / 10;: IF obj(a, 3) = 0 THEN PRINT "FIX";
        'IF wch = a THEN PRINT "<--- using mousewheel !" 'change weights with mousewheel
        IF wch <> -1 THEN obj(wch, 2) = obj(wch, 2) + mw / 10: IF obj(wch, 2) < min_weight THEN obj(wch, 2) = min_weight
    NEXT a
    LOCATE mony / 16 - 2, 1
    IF moving THEN PRINT "press SPACE to FIX/FLY" ELSE PRINT "grab the ball with the mouse and move it!"
    '    PRINT "S-button - rigid / flexible connections";
    'draw objects
    FOR a = 0 TO obj_c - 1: IF obj(a, 4) = 0 THEN _CONTINUE
        x = cent_x + obj(a, 0) * zoom: y = cent_y + obj(a, 1) * zoom
        IF mouse_near = a THEN COLOR _RGB32(255, 0, 0) ELSE COLOR _RGB32(200, 200, 200)
        '        CIRCLE (x, y), obj(a, 2) * zoom: _PRINTSTRING (x, y), LTRIM$(STR$(a))
    NEXT a
 
    'draw connections
 
    COLOR _RGB32(200, 200, 200)
    FOR a = 0 TO conn_c - 1: IF conn(a, 3) = 0 THEN _CONTINUE
        IF obj(conn(a, 0), 4) = 0 OR obj(conn(a, 1), 4) = 0 THEN _CONTINUE
        x1 = obj(conn(a, 0), 0) * zoom + cent_x: y1 = obj(conn(a, 0), 1) * zoom + cent_y
        x2 = obj(conn(a, 1), 0) * zoom + cent_x: y2 = obj(conn(a, 1), 1) * zoom + cent_y
    LINE (x1, y1)-(x2, y2): NEXT a
 
 
 
    'calculate moving
    FOR a = 0 TO obj_c - 1: obj(a, 6) = obj(a, 0): obj(a, 7) = obj(a, 1)
        IF obj(a, 3) = 0 OR (mouse_near = a AND _MOUSEBUTTON(1)) OR obj(a, 4) = 0 THEN _CONTINUE
        'connections vector
        vec_x = 0: vec_y = 0: vec_c = 0
        FOR t = 0 TO conn_c - 1: IF conn(t, 3) = 0 THEN _CONTINUE
            x = -1: FOR t2 = 0 TO 1: IF conn(t, t2) = a THEN x = conn(t, t2 XOR 1)
            NEXT t2
            IF x <> -1 THEN
                IF obj(x, 4) THEN
                    disx = obj(a, 0) - obj(x, 0)
                    disy = obj(a, 1) - obj(x, 1)
                    ang = (-degree(disx, disy) + 0) * pip180
                    dis = SQR(disx * disx + disy * disy)
                    power = (dis - conn(t, 2)) * .6 ' obj(a, 2) ^ 2 '/ 20
                    IF stiff THEN power = power / obj(a, 2) ^ 2 * 4
                    vec_x = vec_x + SIN(ang) * power
                    vec_y = vec_y - COS(ang) * power
                    vec_c = vec_c + 1
                END IF
            END IF
        NEXT t
 
        gravity = 0 '.1
        lass = .90
        obj(a, 4) = (obj(a, 4) + vec_x / vec_c) * lass
        obj(a, 5) = (obj(a, 5) + vec_y / vec_c) * lass + gravity
        obj(a, 6) = obj(a, 0) + obj(a, 4)
        obj(a, 7) = obj(a, 1) + obj(a, 5)
    NEXT a
    FOR a = 0 TO obj_c - 1: FOR t = 0 TO 1: obj(a, t) = obj(a, 6 + t): NEXT t, a
 
 
 
 
    'mouse moving activing
    mw = 0: WHILE _MOUSEINPUT: mw = mw + _MOUSEWHEEL: WEND
    mindis = 99999999
    IF moving = 0 THEN
        mouse_near = -1
        FOR a = 0 TO obj_c - 1
            disx = (cent_x + obj(a, 0) * zoom) - _MOUSEX
            disy = (cent_y + obj(a, 1) * zoom) - _MOUSEY
            dis = SQR(disx * disx + disy * disy)
            IF dis < 60 AND mindis > dis THEN mouse_near = a:mindis = dis
        NEXT a
    END IF
 
    IF (_MOUSEBUTTON(1) AND mouse_near <> -1) OR moving THEN
        moving = 1
        obj(mouse_near, 0) = (_MOUSEX - cent_x) / zoom
        obj(mouse_near, 1) = (_MOUSEY - cent_y) / zoom
    END IF
 
    moving = moving AND _MOUSEBUTTON(1)
 
    stiff = stiff XOR ABS(inkey2$ = "s")
 
 
    _DISPLAY: CLS
 
    'commands
    inkey2$ = INKEY$: IF inkey2$ = CHR$(27) THEN END
    IF inkey2$ = " " AND _MOUSEBUTTON(1) AND moving THEN obj(mouse_near, 3) = obj(mouse_near, 3) XOR 1
 
 
LOOP
 
 
 
 
FUNCTION degree (a, b): degreex = ATN(a / (b + .00001)) / pip180: degreex = degreex - 180 * ABS(0 > b): degreex = degreex - 360 * (degreex < 0): degree = degreex: END FUNCTION
 
FUNCTION randx (x): randx = x * RND(1) - x / 2: END FUNCTION

Title: Re: Garland of pearls
Post by: MasterGy on March 22, 2022, 07:09:43 pm

enter a picture in the program "temp = _LOADIMAGE("pic.jpg", 32)"
crush the picture with your mouse!

Code: QB64: [Select]

RANDOMIZE TIMER
CONST pip180 = 3.141592 / 180
monx = 800: mony = monx / _DESKTOPWIDTH * _DESKTOPHEIGHT: mon = _NEWIMAGE(monx, mony, 32): SCREEN mon: _DISPLAYORDER _HARDWARE , _SOFTWARE
_FULLSCREEN
 
min_weight = 6
gravity = 1
obj_c = 1000 'number objects
DIM obj(obj_c - 1, 9) '0,1 posX,Y 3fix/mover
cent_x = monx / 2: cent_y = mony / 2: zoom = 2.4
 
 
 
conn_c = 1000: DIM conn(conn_c - 1, 4)
 
 
temp = _LOADIMAGE("pic.jpg", 32): _DEST temp: _SETALPHA 100: pic = _COPYIMAGE(temp, 33): _FREEIMAGE temp
 
sizex = 300: sizey = INT(sizex / _WIDTH(pic) * _HEIGHT(pic))
felbx = 15: felby = INT(felbx / _WIDTH(pic) * _HEIGHT(pic))
unitx = INT(_WIDTH(pic) / (felbx - 1))
unity = INT(_HEIGHT(pic) / (felby - 1))
 
 
FOR ty = 0 TO felby - 1
    FOR tx = 0 TO felbx - 1
        aobj = tx + ty * felbx
        obj(aobj, 0) = sizex / felbx * tx - sizex / 2
        obj(aobj, 1) = sizey / felby * ty - sizey / 2
        obj(aobj, 2) = 5
        obj(aobj, 3) = 1
        IF (ty = 0 OR ty = felby - 1) AND (tx = 0 OR tx = felbx - 1) THEN obj(aobj, 3) = 0
        obj(aobj, 4) = 1
    NEXT tx
NEXT ty
 
 
'connections
FOR ty = 0 TO felby - 1: FOR tx = 0 TO felbx - 2: conn(ac, 0) = tx + ty * felbx: conn(ac, 1) = conn(ac, 0) + 1
        conn(ac, 2) = SQR((obj(conn(ac, 0), 0) - obj(conn(ac, 1), 0)) ^ 2 + (obj(conn(ac, 0), 1) - obj(conn(ac, 1), 1)) ^ 2) * .8
conn(ac, 3) = 1: ac = ac + 1: NEXT tx, ty
 
FOR tx = 0 TO felbx - 1: FOR ty = 0 TO felby - 2: conn(ac, 0) = tx + ty * felbx: conn(ac, 1) = conn(ac, 0) + felbx
        conn(ac, 2) = SQR((obj(conn(ac, 0), 0) - obj(conn(ac, 1), 0)) ^ 2 + (obj(conn(ac, 0), 1) - obj(conn(ac, 1), 1)) ^ 2) * .8
conn(ac, 3) = 1: ac = ac + 1: NEXT ty, tx
 
 
 
 
 
 
 
 
 
 
stiff = 1
COLOR , 0
DO: _LIMIT 30 '100
 
    'show info
    wch = -1: FOR a = 0 TO obj_c - 1
        IF _MOUSEX < 200 AND INT(_MOUSEY / 16) = a THEN wch = a: COLOR _RGB32(255, 255, 255) ELSE COLOR _RGB32(100, 100, 100)
        ' LOCATE a + 1, 1: PRINT a; "# weight:"; INT(obj(a, 2) * 10) / 10;: IF obj(a, 3) = 0 THEN PRINT "FIX";
        'IF wch = a THEN PRINT "<--- using mousewheel !" 'change weights with mousewheel
        IF wch <> -1 THEN obj(wch, 2) = obj(wch, 2) + mw / 10: IF obj(wch, 2) < min_weight THEN obj(wch, 2) = min_weight
    NEXT a
    LOCATE mony / 16 - 2, 1
    IF moving THEN PRINT "press SPACE to FIX/FLY" ELSE PRINT "grab the ball with the mouse and move it!"
    '    PRINT "S-button - rigid / flexible connections";
    'draw objects
    FOR a = 0 TO obj_c - 1: IF obj(a, 4) = 0 THEN _CONTINUE
        x = cent_x + obj(a, 0) * zoom: y = cent_y + obj(a, 1) * zoom
        obj(a, 8) = x
        obj(a, 9) = y
        IF mouse_near = a THEN COLOR _RGB32(255, 0, 0) ELSE COLOR _RGB32(200, 200, 200)
        '        CIRCLE (x, y), obj(a, 2) * zoom: _PRINTSTRING (x, y), LTRIM$(STR$(a))
 
    NEXT a
 
    'draw connections
    COLOR _RGB32(200, 200, 200)
    FOR a = 0 TO conn_c - 1: IF conn(a, 3) = 0 THEN _CONTINUE
        IF obj(conn(a, 0), 4) = 0 OR obj(conn(a, 1), 4) = 0 THEN _CONTINUE
        x1 = obj(conn(a, 0), 0) * zoom + cent_x: y1 = obj(conn(a, 0), 1) * zoom + cent_y
        x2 = obj(conn(a, 1), 0) * zoom + cent_x: y2 = obj(conn(a, 1), 1) * zoom + cent_y
        '    LINE (x1, y1)-(x2, y2), _RGBA32(0, 0, 0, 128)
    NEXT a
 
 
 
    'calculate moving
    FOR a = 0 TO obj_c - 1: obj(a, 6) = obj(a, 0): obj(a, 7) = obj(a, 1)
        IF obj(a, 3) = 0 OR (mouse_near = a AND _MOUSEBUTTON(1)) OR obj(a, 4) = 0 THEN _CONTINUE
        'connections vector
        vec_x = 0: vec_y = 0: vec_c = 0
        FOR t = 0 TO conn_c - 1: IF conn(t, 3) = 0 THEN _CONTINUE
            x = -1: FOR t2 = 0 TO 1: IF conn(t, t2) = a THEN x = conn(t, t2 XOR 1)
            NEXT t2
            IF x <> -1 THEN
                IF obj(x, 4) THEN
                    disx = obj(a, 0) - obj(x, 0)
                    disy = obj(a, 1) - obj(x, 1)
                    ang = (-degree(disx, disy) + 0) * pip180
                    dis = SQR(disx * disx + disy * disy)
                    power = (dis - conn(t, 2)) * 2
                    IF stiff THEN power = power / obj(a, 2) ^ 2 * 4
                    vec_x = vec_x + SIN(ang) * power
                    vec_y = vec_y - COS(ang) * power
                    vec_c = vec_c + 1
                END IF
            END IF
        NEXT t
 
        gravity = 0 '.1
        lass = .93
        obj(a, 4) = (obj(a, 4) + vec_x / vec_c) * lass
        obj(a, 5) = (obj(a, 5) + vec_y / vec_c) * lass + gravity
        obj(a, 6) = obj(a, 0) + obj(a, 4)
        obj(a, 7) = obj(a, 1) + obj(a, 5)
    NEXT a
    FOR a = 0 TO obj_c - 1: FOR t = 0 TO 1: obj(a, t) = obj(a, 6 + t): NEXT t, a
 
 
 
 
    'mouse moving activing
    mw = 0: WHILE _MOUSEINPUT: mw = mw + _MOUSEWHEEL: WEND
    mindis = 99999999
    IF moving = 0 THEN
        mouse_near = -1
        FOR a = 0 TO obj_c - 1
            disx = (cent_x + obj(a, 0) * zoom) - _MOUSEX
            disy = (cent_y + obj(a, 1) * zoom) - _MOUSEY
            dis = SQR(disx * disx + disy * disy)
            IF dis < 60 AND mindis > dis THEN mouse_near = a: mindis = dis
        NEXT a
    END IF
 
    IF (_MOUSEBUTTON(1) AND mouse_near <> -1) OR moving THEN
        moving = 1
        obj(mouse_near, 0) = (_MOUSEX - cent_x) / zoom
        obj(mouse_near, 1) = (_MOUSEY - cent_y) / zoom
    END IF
 
    moving = moving AND _MOUSEBUTTON(1)
 
    stiff = stiff XOR ABS(inkey2$ = "s")
 
    'picture draw
    FOR ty = 0 TO felby - 2: sy1 = INT(unity * ty): sy2 = sy1 + unity - 1
        FOR tx = 0 TO felbx - 2: sx1 = INT(unitx * tx): sx2 = sx1 + unitx - 1: aobj = tx + ty * felbx
            FOR t = 0 TO 7: p(t) = obj(aobj + (t AND 1) + SGN(t AND 2) * felbx, 8 + SGN(t AND 4)): NEXT t
            _MAPTRIANGLE (sx1, sy1)-(sx2, sy1)-(sx1, sy2), pic TO(p(0), p(4))-(p(1), p(5))-(p(2), p(6))
            _MAPTRIANGLE (sx2, sy2)-(sx2, sy1)-(sx1, sy2), pic TO(p(3), p(7))-(p(1), p(5))-(p(2), p(6))
        NEXT tx
    NEXT ty
 
    _DISPLAY: CLS
 
    'commands
    inkey2$ = INKEY$: IF inkey2$ = CHR$(27) THEN END
    IF inkey2$ = " " AND _MOUSEBUTTON(1) AND moving THEN obj(mouse_near, 3) = obj(mouse_near, 3) XOR 1
 
 
LOOP
 
 
FUNCTION degree (a, b): degreex = ATN(a / (b + .00001)) / pip180: degreex = degreex - 180 * ABS(0 > b): degreex = degreex - 360 * (degreex < 0): degree = degreex: END FUNCTION
FUNCTION randx (x): randx = x * RND(1) - x / 2: END FUNCTION
 

Title: Re: Garland of pearls
Post by: Dav on March 22, 2022, 09:59:26 pm

Wow -- that image version is about the coolest effect I've seen in QB64...

- Dav

Title: Re: Garland of pearls
Post by: STxAxTIC on March 22, 2022, 10:47:24 pm

Yeah, this really is something special!

Title: Re: Garland of pearls
Post by: bplus on March 23, 2022, 01:09:12 pm

MasterGy is on a roll!

Title: Re: Garland of pearls
Post by: FellippeHeitor on March 23, 2022, 01:17:20 pm

Wow, I only managed to run this now and I LOVE this spider web. Such cool work, MasterGy.

Quote from: MasterGy on March 22, 2022, 03:36:20 pm

grab the cobweb!

Code: QB64: [Select]
RANDOMIZE TIMER
CONST pip180 = 3.141592 / 180
monx = 800: mony = 800: mon = _NEWIMAGE(monx, mony, 32): SCREEN mon

min_weight = 6
gravity = 1
obj_c = 1000 'number objects
DIM obj(obj_c - 1, 9) '0,1 posX,Y 3fix/mover
cent_x = monx / 2: cent_y = mony / 2: zoom = 1.8

'cobweb
ag0 = 320 'size
ag1 = 18 'felbontas ag
ag2 = 14 'felbontas net
ag3 = ag0 * .18 / 2 'rad1
ag4 = ag0 * .9 / 2 'rad2

FOR t = 0 TO ag1 - 1
ang = (360 / ag1 * t + randx(360 / ag1 * .3)) * pip180
dis = ABS(ag3 - ag4)
x1 = SIN(ang) * ag3 + randx(ag3 * .1)
y1 = COS(ang) * ag3 + randx(ag3 * .1)
x2 = SIN(ang) * ag4 + randx(ag4 * .2)
y2 = COS(ang) * ag4 + randx(ag4 * .2)

FOR t2 = 0 TO ag2 - 1
aobj = t2 + ag2 * t
obj(aobj, 0) = x1 + (x2 - x1) / (ag2 - 1) * t2
obj(aobj, 1) = y1 + (y2 - y1) / (ag2 - 1) * t2
obj(aobj, 2) = 1.9 'min_weight
obj(aobj, 3) = 1
' IF t2 = ag2 - 1 THEN obj(aobj, 3) = 0

obj(aobj, 4) = 1
NEXT t2
NEXT t

'connections
conn_c = 1000: DIM conn(conn_c - 1, 4): ac = 0

FOR t = 0 TO ag2 - 2: FOR t2 = 0 TO ag1 - 1: conn(ac, 0) = t2 * ag2 + t: conn(ac, 1) = t2 * ag2 + ((t + 1) MOD ag2)
conn(ac, 2) = SQR((obj(conn(ac, 0), 0) - obj(conn(ac, 1), 0)) ^ 2 + (obj(conn(ac, 0), 1) - obj(conn(ac, 1), 1)) ^ 2)
conn(ac, 2) = conn(ac, 2) + randx(conn(ac, 2) * .1)
conn(ac, 3) = 1: ac = ac + 1: NEXT t2, t

FOR t = 0 TO ag2 - 1: FOR t2 = 0 TO ag1 - 1: conn(ac, 0) = t + ag2 * t2: conn(ac, 1) = t + ag2 * ((t2 + 1) MOD ag1)
conn(ac, 2) = SQR((obj(conn(ac, 0), 0) - obj(conn(ac, 1), 0)) ^ 2 + (obj(conn(ac, 0), 1) - obj(conn(ac, 1), 1)) ^ 2)
conn(ac, 2) = conn(ac, 2) + randx(conn(ac, 2) * .1)
conn(ac, 3) = 1: ac = ac + 1: NEXT t2, t

polar_p = ag1 * ag2
FOR t = 0 TO 3
obj(polar_p + t, 0) = ((t AND 1) * 2 - 1) * ag0 / 2
obj(polar_p + t, 1) = (SGN(t AND 2) * 2 - 1) * ag0 / 2
obj(polar_p + t, 2) = 6 'min_weight
obj(polar_p + t, 3) = 0
obj(polar_p + t, 4) = 1
mindis = 999999999

FOR a = 0 TO polar_p - 1
dis = SQR((obj(polar_p + t, 0) - obj(a, 0)) ^ 2 + (obj(polar_p + t, 1) - obj(a, 1)) ^ 2) * .8
IF dis < mindis THEN mindis = dis: conn_n = a
NEXT a
conn(ac, 0) = polar_p + t
conn(ac, 1) = conn_n
conn(ac, 2) = mindis
conn(ac, 3) = 1
ac = ac + 1

NEXT t

stiff = 1

DO: _LIMIT 100

'show info
wch = -1: FOR a = 0 TO obj_c - 1
IF _MOUSEX < 200 AND INT(_MOUSEY / 16) = a THEN wch = a: COLOR _RGB32(255, 255, 255) ELSE COLOR _RGB32(100, 100, 100)
' LOCATE a + 1, 1: PRINT a; "# weight:"; INT(obj(a, 2) * 10) / 10;: IF obj(a, 3) = 0 THEN PRINT "FIX";
'IF wch = a THEN PRINT "<--- using mousewheel !" 'change weights with mousewheel
IF wch <> -1 THEN obj(wch, 2) = obj(wch, 2) + mw / 10: IF obj(wch, 2) < min_weight THEN obj(wch, 2) = min_weight
NEXT a
LOCATE mony / 16 - 2, 1
IF moving THEN PRINT "press SPACE to FIX/FLY" ELSE PRINT "grab the ball with the mouse and move it!"
' PRINT "S-button - rigid / flexible connections";
'draw objects
FOR a = 0 TO obj_c - 1: IF obj(a, 4) = 0 THEN _CONTINUE
x = cent_x + obj(a, 0) * zoom: y = cent_y + obj(a, 1) * zoom
IF mouse_near = a THEN COLOR _RGB32(255, 0, 0) ELSE COLOR _RGB32(200, 200, 200)
' CIRCLE (x, y), obj(a, 2) * zoom: _PRINTSTRING (x, y), LTRIM$(STR$(a))
NEXT a

'draw connections

COLOR _RGB32(200, 200, 200)
FOR a = 0 TO conn_c - 1: IF conn(a, 3) = 0 THEN _CONTINUE
IF obj(conn(a, 0), 4) = 0 OR obj(conn(a, 1), 4) = 0 THEN _CONTINUE
x1 = obj(conn(a, 0), 0) * zoom + cent_x: y1 = obj(conn(a, 0), 1) * zoom + cent_y
x2 = obj(conn(a, 1), 0) * zoom + cent_x: y2 = obj(conn(a, 1), 1) * zoom + cent_y
LINE (x1, y1)-(x2, y2): NEXT a

'calculate moving
FOR a = 0 TO obj_c - 1: obj(a, 6) = obj(a, 0): obj(a, 7) = obj(a, 1)
IF obj(a, 3) = 0 OR (mouse_near = a AND _MOUSEBUTTON(1)) OR obj(a, 4) = 0 THEN _CONTINUE
'connections vector
vec_x = 0: vec_y = 0: vec_c = 0
FOR t = 0 TO conn_c - 1: IF conn(t, 3) = 0 THEN _CONTINUE
x = -1: FOR t2 = 0 TO 1: IF conn(t, t2) = a THEN x = conn(t, t2 XOR 1)
NEXT t2
IF x <> -1 THEN
IF obj(x, 4) THEN
disx = obj(a, 0) - obj(x, 0)
disy = obj(a, 1) - obj(x, 1)
ang = (-degree(disx, disy) + 0) * pip180
dis = SQR(disx * disx + disy * disy)
power = (dis - conn(t, 2)) * .6 ' obj(a, 2) ^ 2 '/ 20
IF stiff THEN power = power / obj(a, 2) ^ 2 * 4
vec_x = vec_x + SIN(ang) * power
vec_y = vec_y - COS(ang) * power
vec_c = vec_c + 1
END IF
END IF
NEXT t

gravity = 0 '.1
lass = .90
obj(a, 4) = (obj(a, 4) + vec_x / vec_c) * lass
obj(a, 5) = (obj(a, 5) + vec_y / vec_c) * lass + gravity
obj(a, 6) = obj(a, 0) + obj(a, 4)
obj(a, 7) = obj(a, 1) + obj(a, 5)
NEXT a
FOR a = 0 TO obj_c - 1: FOR t = 0 TO 1: obj(a, t) = obj(a, 6 + t): NEXT t, a

'mouse moving activing
mw = 0: WHILE _MOUSEINPUT: mw = mw + _MOUSEWHEEL: WEND
mindis = 99999999
IF moving = 0 THEN
mouse_near = -1
FOR a = 0 TO obj_c - 1
disx = (cent_x + obj(a, 0) * zoom) - _MOUSEX
disy = (cent_y + obj(a, 1) * zoom) - _MOUSEY
dis = SQR(disx * disx + disy * disy)
IF dis < 60 AND mindis > dis THEN mouse_near = a:mindis = dis
NEXT a
END IF

IF (_MOUSEBUTTON(1) AND mouse_near <> -1) OR moving THEN
moving = 1
obj(mouse_near, 0) = (_MOUSEX - cent_x) / zoom
obj(mouse_near, 1) = (_MOUSEY - cent_y) / zoom
END IF

moving = moving AND _MOUSEBUTTON(1)

stiff = stiff XOR ABS(inkey2$ = "s")

_DISPLAY: CLS

'commands
inkey2$ = INKEY$: IF inkey2$ = CHR$(27) THEN END
IF inkey2$ = " " AND _MOUSEBUTTON(1) AND moving THEN obj(mouse_near, 3) = obj(mouse_near, 3) XOR 1

LOOP

FUNCTION degree (a, b): degreex = ATN(a / (b + .00001)) / pip180: degreex = degreex - 180 * ABS(0 > b): degreex = degreex - 360 * (degreex < 0): degree = degreex: END FUNCTION

FUNCTION randx (x): randx = x * RND(1) - x / 2: END FUNCTION

Title: Re: Garland of pearls
Post by: MasterGy on March 23, 2022, 08:00:58 pm

There is much more to it than interesting!
I asked the question on a Hungarian physics forum on facebook. If there is a meaningful answer, I will inform you! It needs to be addressed!

Hello !
It will be a little longer now. I want an answer to a question I haven't been able to sleep in days :)
Anyone who follows the group may know that I am involved in programming. It used to be machine control, more recently the math behind games. (Interestingly, behind the game programming are the most outdated applications of mathematics)
My recent creations:

I have only considered it important to note this now because I have been dealing with them feverishly lately. The basic development environment, in which I program, can only draw 1 triangle on the screen. That's why I wrote the graphic "engine", the camera movement, the physical background of the movements myself. This developer is so unpopular that I don't think QB64 is known in Hungary. I like to be active in a foreign forum because there are about a handful of people (a handful on a global scale) who struggle with this outdated developer and appreciate it.
Here a forum member wrote a simulation of a pendulum motion. This should be imagined as a fixed point + rigid connector + some weight + rigid connector + some weight .... What happens if we push? He returned the thing quite realistically on the screen. It’s some crazy math, a lot of computation, and limited because it works with 2 “weights,” and with 3, but 4 or more has so much computation that it crumbles all over and can’t be shown in real time.
I had an idea then. What if we created points in space / plane without giving it fixed coordinates. All you need to know about that point is that it is located relative to another point. There should be nothing else for that point other than to strive to maintain its relation to the other point specified.
Do this: "current situation" = "current situation" + ("where you should be" - "current situation") x "all"
This is important here. If "all" is 0, no change is made. If 1, an immediate change occurs. If all are between 0 and 1, it gives a proportionality to the dynamics / flexibility / speed of change.
Now I want to express the point somehow. Imagine a "space." It contains objects. Objects are defined by point clouds. In point clouds, we make connections between points. To an adjacent, or object center, or just a smooth random point, we connect the 1 given point within the point cloud that we just want to define, "smart." We determine for him how far away he should be from that other point ... We will try to make as many such "connections" as possible at all points in that point and that object so that he is as smart as possible and will know "where he is. ".
If this is the case, start the "simulation"! Suppose thousands of points are defined as above. Each point begins to move at such a speed / direction that the connections assigned to it can be fulfilled. All right, we're waiting ... after a while, all movement will stop. "system balanced". The shapes are nicely outlined in front of us.
Now move only 1 out of position !!! that is, ONE point !!!!!!!! This will affect the points you are connected to ... and also the points you are connected to ... and those .... so everyone is running that 1 pulse. A mechanism is starting. Impulses give and take ...
The video shows how I programmed this principle differently. Chain, an image, and a cobweb. In each case, I gave relationships to the points as above. The thing works. And here comes the point. Smart people have already written the mathematical model for every event in Newtonian physics. Rigid-body, wave curves, collision of bodies, pendulum motion, centrifugal force .... what else to say ???????????????
This idea, which I did, completely bypasses the knowledge and use of these. The screen is fully functional. You don't need any physical knowledge or complications. We need a point and the strengths of its connections and connections (or how long we tie it to another point) (perhaps a metaphor for mass?)
Using the principle, we can in principle simulate all Newtonian physics by completely circumventing their use. Example..something .... if we create a brick wall based on the above principle, we can shoot a brick out of it so that the wall collapses in reality..etc ... that's just 1 of the many options.
Here's my question. Unfortunately, I did not study mathematics or physics at higher levels. I'm sure this thing isn't some kind of invention. This can only be new to me. This may be a known, existing theory that is also taught in good places. I would like to ask those who were so lucky to learn things like what it is? what is it used for where can i find writing about this
Thank you!

(just a small philosophical remark: if we hit the wall! the above principle would show the tiny vibration of every part of the wall. what if the above principle simulates the connection between molecules? since reality "renders" so fast that we can't even measure it with instruments, we're just amazed at the end result, because it happens so fast that we can't see, so we don't understand)
To download programs running under video (running under windows) with source code:
https://drive.google.com/file/d/1hkIqbFx_JGzhYpGdQjZ1h0lZYFtiw3Ce/view?usp=sharing

Title: Re: Garland of pearls
Post by: bplus on March 23, 2022, 08:30:34 pm

Quote from: MasterGy on March 23, 2022, 08:00:58 pm

There is much more to it than interesting!
I asked the question on a Hungarian physics forum on facebook. If there is a meaningful answer, I will inform you! It needs to be addressed!

Hello !
It will be a little longer now. I want an answer to a question I haven't been able to sleep in days :)
Anyone who follows the group may know that I am involved in programming. It used to be machine control, more recently the math behind games. (Interestingly, behind the game programming are the most outdated applications of mathematics)
My recent creations:

I have only considered it important to note this now because I have been dealing with them feverishly lately. The basic development environment, in which I program, can only draw 1 triangle on the screen. That's why I wrote the graphic "engine", the camera movement, the physical background of the movements myself. This developer is so unpopular that I don't think QB64 is known in Hungary. I like to be active in a foreign forum because there are about a handful of people (a handful on a global scale) who struggle with this outdated developer and appreciate it.
Here a forum member wrote a simulation of a pendulum motion. This should be imagined as a fixed point + rigid connector + some weight + rigid connector + some weight .... What happens if we push? He returned the thing quite realistically on the screen. It’s some crazy math, a lot of computation, and limited because it works with 2 “weights,” and with 3, but 4 or more has so much computation that it crumbles all over and can’t be shown in real time.
I had an idea then. What if we created points in space / plane without giving it fixed coordinates. All you need to know about that point is that it is located relative to another point. There should be nothing else for that point other than to strive to maintain its relation to the other point specified.
Do this: "current situation" = "current situation" + ("where you should be" - "current situation") x "all"
This is important here. If "all" is 0, no change is made. If 1, an immediate change occurs. If all are between 0 and 1, it gives a proportionality to the dynamics / flexibility / speed of change.
Now I want to express the point somehow. Imagine a "space." It contains objects. Objects are defined by point clouds. In point clouds, we make connections between points. To an adjacent, or object center, or just a smooth random point, we connect the 1 given point within the point cloud that we just want to define, "smart." We determine for him how far away he should be from that other point ... We will try to make as many such "connections" as possible at all points in that point and that object so that he is as smart as possible and will know "where he is. ".
If this is the case, start the "simulation"! Suppose thousands of points are defined as above. Each point begins to move at such a speed / direction that the connections assigned to it can be fulfilled. All right, we're waiting ... after a while, all movement will stop. "system balanced". The shapes are nicely outlined in front of us.
Now move only 1 out of position !!! that is, ONE point !!!!!!!! This will affect the points you are connected to ... and also the points you are connected to ... and those .... so everyone is running that 1 pulse. A mechanism is starting. Impulses give and take ...
The video shows how I programmed this principle differently. Chain, an image, and a cobweb. In each case, I gave relationships to the points as above. The thing works. And here comes the point. Smart people have already written the mathematical model for every event in Newtonian physics. Rigid-body, wave curves, collision of bodies, pendulum motion, centrifugal force .... what else to say ???????????????
This idea, which I did, completely bypasses the knowledge and use of these. The screen is fully functional. You don't need any physical knowledge or complications. We need a point and the strengths of its connections and connections (or how long we tie it to another point) (perhaps a metaphor for mass?)
Using the principle, we can in principle simulate all Newtonian physics by completely circumventing their use. Example..something .... if we create a brick wall based on the above principle, we can shoot a brick out of it so that the wall collapses in reality..etc ... that's just 1 of the many options.
Here's my question. Unfortunately, I did not study mathematics or physics at higher levels. I'm sure this thing isn't some kind of invention. This can only be new to me. This may be a known, existing theory that is also taught in good places. I would like to ask those who were so lucky to learn things like what it is? what is it used for where can i find writing about this
Thank you!

(just a small philosophical remark: if we hit the wall! the above principle would show the tiny vibration of every part of the wall. what if the above principle simulates the connection between molecules? since reality "renders" so fast that we can't even measure it with instruments, we're just amazed at the end result, because it happens so fast that we can't see, so we don't understand)
To download programs running under video (running under windows) with source code:
https://drive.google.com/file/d/1hkIqbFx_JGzhYpGdQjZ1h0lZYFtiw3Ce/view?usp=sharing

Ha! I don't think a spring connects every particle with every other but makes an interesting computer experiment.

Code: QB64: [Select]

_Title "Mouse down, drag ball, release...  Boing" 'B+ 2019-01-08 from
'boing.bas for SmallBASIC 2015-07-25 MGA/B+
'coloring mods
 
Const xmax = 1200
Const ymax = 700
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 80, 20
 
Dim s(1 To 4, 1 To 2)
s(1, 1) = 0: s(1, 2) = 50
s(2, 1) = 0: s(2, 2) = ymax - 50
s(3, 1) = xmax + 30: s(3, 2) = 50
s(4, 1) = xmax + 30: s(4, 2) = ymax - 50
oldtx = 0: oldtyty = 0: da = .03
boingx = 0: boingy = 0
While 1
    While _MouseInput: Wend
    mb = _MouseButton(1)
    If mb Then
        tx = _MouseX + 20
        ty = _MouseY
    Else
        tx = xmax / 2
        ty = ymax / 2
        If tx <> oldtx Or ty <> oldty Then
            boingx = 3 * (tx - oldtx) / 4
            boingy = 3 * (ty - oldty) / 4
        Else
            boingx = -3 * boingx / 4
            boingy = -3 * boingy / 4
        End If
        tx = tx + boingx
        ty = ty + boingy
    End If
    a = 0
    oldtx = tx
    oldty = ty
    Cls
    For corner = 1 To 4
        s1x = s(corner, 1)
        s1y = s(corner, 2)
        dx = (tx - s1x) / 2000
        dy = (ty - s1y) / 2000
        x = tx - 20
        y = ty
        For i = 1 To 2000
            sx = 20 * Cos(a) + x
            sy = 20 * Sin(a) + y
            Line (sx, sy + 5)-(sx + 4, sy + 5), _RGB32(118, 118, 118), BF
            Line (sx, sy + 4)-(sx + 4, sy + 4), _RGB32(148, 148, 148), BF
            Line (sx, sy + 3)-(sx + 4, sy + 3), _RGB32(238, 238, 238), BF
            Line (sx, sy + 2)-(sx + 4, sy + 3), _RGB32(208, 208, 208), BF
            Line (sx, sy + 1)-(sx + 4, sy + 1), _RGB32(168, 168, 168), BF
            Line (sx, sy)-(sx + 4, sy), _RGB32(108, 108, 108), BF
            Line (sx, sy - 1)-(sx + 4, sy - 1), _RGB32(68, 68, 68), BF
            x = x - dx: y = y - dy
            a = a + da
        Next
    Next
    For r = 50 To 1 Step -1
        g = (50 - r) * 5 + 5
        Color _RGB32(g, g, g)
        fcirc tx - 20, ty, r
    Next
    _Display
    _Limit 15
Wend
 
'Steve McNeil's  copied from his forum   note: Radius is too common a name
Sub fcirc (CX As Long, CY As Long, R As Long)
    Dim subRadius As Long, RadiusError As Long
    Dim X As Long, Y As Long
 
    subRadius = Abs(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0
 
    If subRadius = 0 Then PSet (CX, CY): Exit Sub
 
    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    Line (CX - X, CY)-(CX + X, CY), , BF
 
    While X > Y
        RadiusError = RadiusError + Y * 2 + 1
        If RadiusError >= 0 Then
            If X <> Y + 1 Then
                Line (CX - Y, CY - X)-(CX + Y, CY - X), , BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), , BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), , BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), , BF
    Wend
End Sub
 
 

@MasterGy try and get some sleep.

Title: Re: Garland of pearls
Post by: jack on March 24, 2022, 09:28:11 am

Quote from: MasterGy on March 23, 2022, 08:00:58 pm

To download programs running under video (running under windows) with source code:
https://drive.google.com/file/d/1hkIqbFx_JGzhYpGdQjZ1h0lZYFtiw3Ce/view?usp=sharing

I get an error from google not allowing me to download, is there another way you can share your creations?
btw, the programs you presented in this thread are fantastic! :)

Title: Re: Garland of pearls
Post by: MasterGy on April 03, 2022, 02:57:42 pm

I'm very interested in this thing. Unfortunately I had little time, the season started. The above programs work in 2d. I started simulating the behavior of points in 3d. The goal would be collisions. I would like to see what I have described above. For now, you can see that it works nicely in 3D as well. Stretched mesh, gravity, WASD + mouse like in games. Use the space bar to move 1 point out of place. All other points will then respond and the system will attempt to return to the idle state.

Code: QB64: [Select]

mouse_sens = .5
tightness = 2
gravity = .005
lass = .94
power = -0.3
 
 
 
RANDOMIZE TIMER
CONST pip180 = 3.141592 / 180
DIM SHARED monx, mony: monx = 800: mony = monx / _DESKTOPWIDTH * _DESKTOPHEIGHT: mon = _NEWIMAGE(monx, mony, 32): SCREEN mon: _FULLSCREEN: _MOUSEHIDE
 
DIM SHARED points_c_arr, conn_c_arr
points_c_arr = 2000
conn_c_arr = 2000
 
DIM SHARED points(points_c_arr, 19), conn(conn_c_arr, 9), cam(19), me(19), conn_c, points_c
 
 
make_grid 1, -10, -10, 10, 10, -10, 0, -10, 10, 0, 10, 10, 0, 1.2
 
 
 
 
 
'make_sphere 2, 0, 10, 0, 5, 8 'ident,X,Y,Z,RAD,POINTS
DO: _LIMIT 30
 
    'control
    mousex = 0: mousey = 0: mw = 0: WHILE _MOUSEINPUT: mousex = mousex + _MOUSEMOVEMENTX: mousey = mousey + _MOUSEMOVEMENTY: mw = mw + _MOUSEWHEEL: WEND
    k_left = _KEYDOWN(19200) OR _KEYDOWN(ASC("a")): k_right = _KEYDOWN(19712) OR _KEYDOWN(ASC("d"))
    k_up = _KEYDOWN(18432) OR _KEYDOWN(ASC("w")): k_down = _KEYDOWN(20480) OR _KEYDOWN(ASC("s"))
    me(2) = me(2) + mw: me(3) = me(3) - mousex * mouse_sens: me(4) = me(4) + mousey * mouse_sens: IF ABS(me(4)) > 80 THEN me(4) = 80 * SGN(me(4))
    go = -.5 * ABS(k_left OR k_right OR k_up OR k_down): go_ang = -90 * (k_left - k_right) + (me(3)) - 90
    ang1 = go_ang * pip180: ang2 = (90 - me(4)) * pip180: IF k_down THEN go = -go
    me(0) = me(0) + SIN(ang2) * COS(ang1) * go: me(1) = me(1) + SIN(ang2) * SIN(ang1) * go: me(2) = me(2) + COS(ang2) * go
    FOR t = 0 TO 9: cam(t) = me(t): NEXT t: cam(13) = cam(3) * pip180: cam(14) = cam(4) * pip180
 
 
 
    'calculate moving
 
    FOR a = 0 TO points_c_arr - 1: FOR t = 0 TO 2: points(a, 11 + t) = points(a, t): NEXT t: IF (points(a, 14) = 0 OR points(a, 6) = 0) THEN _CONTINUE
 
        'connections vector
        vec(0) = 0: vec(1) = 0: vec(2) = 0: vec_c = 0
        FOR t = 0 TO conn_c - 1: IF conn(t, 3) = 0 THEN _CONTINUE
            x = -1: FOR t2 = 0 TO 1: IF conn(t, t2) = a THEN x = conn(t, t2 XOR 1)
            NEXT t2
            IF x <> -1 THEN
                FOR av = 0 TO 2: disv = points(a, av) - points(x, av): vec(av) = vec(av) + ((ABS(disv) - conn(t, 4 + av))) * SGN(disv) * power
                NEXT av: vec_c = vec_c + 1
            END IF
        NEXT t
 
        FOR av = 0 TO 2: points(a, 3 + av) = (points(a, 3 + av) + vec(av) / vec_c) * lass: NEXT av: points(a, 4) = points(a, 4) - gravity
        FOR av = 0 TO 2: points(a, 11 + av) = points(a, av) + points(a, 3 + av): NEXT av
    NEXT a
 
    FOR a = 0 TO points_c_arr - 1: FOR t = 0 TO 2: points(a, t) = points(a, 11 + t): NEXT t, a
 
    inkey2$ = INKEY$
    IF inkey2$ = " " THEN
        DO: a = INT(points_c_arr * RND(1)): LOOP UNTIL points(a, 14) AND points(a, 6)
        rand = 30: FOR t = 0 TO 2: points(a, t) = points(a, t) + rand * RND(1) - rand / 2: NEXT t
    END IF
 
    'calculating points
    FOR ap = 0 TO points_c_arr - 1: IF points(ap, 6) = 0 THEN _CONTINUE
        points(ap, 8) = points(ap, 0): points(ap, 9) = points(ap, 1): points(ap, 10) = points(ap, 2)
    rotate_display points(ap, 8), points(ap, 9), points(ap, 10): NEXT ap
 
    'draw connections
    FOR ac = 0 TO conn_c_arr - 1: IF conn(ac, 3) = 0 THEN _CONTINUE
        FOR t1 = 0 TO 1: FOR t2 = 0 TO 2: coo(t1, t2) = points(conn(ac, t1), 8 + t2): NEXT t2, t1
        line_3d coo(0, 0), coo(0, 1), coo(0, 2), coo(1, 0), coo(1, 1), coo(1, 2)
    NEXT ac
 
    'fix points draw signal
    FOR ap = 0 TO points_c_arr - 1: IF points(ap, 6) = 0 OR points(ap, 14) OR points(ap, 10) > -1 THEN _CONTINUE
        FOR t2 = 0 TO 2: coo(0, t2) = points(ap, 8 + t2): NEXT t2
        point3d_to_pset coo(0, 0), coo(0, 1), coo(0, 2): CIRCLE (coo(0, 0), coo(0, 1)), 12000 / coo(0, 2)
    NEXT ap
 
    COLOR _RGB32(200, 200, 200): LOCATE mony / 16 - 2: PRINT "WASD+mouse      SPACE - impulse to a random point ";
    _DISPLAY
    CLS
LOOP
 
 
SUB line_3d (x0, y0, z0, x1, y1, z1)
    IF z0 < -1 AND z1 < -1 THEN point3d_to_pset x0, y0, z0: point3d_to_pset x1, y1, z1: LINE (x0, y0)-(x1, y1)
END SUB
 
SUB point3d_to_pset (x, y, z): multi = 400: zlimit = -2: x = monx / 2 + (x + zlimit) / -z * multi: y = mony / 2 + (y + zlimit) / z * multi
    grey = 255 - ABS(z) * .1: IF grey < 10 THEN grey = 10
    COLOR _RGB32(grey, grey, grey)
END SUB
 
SUB make_grid (acc, x0, y0, z0, x1, y1, z1, x2, y2, z2, x3, y3, z3, res): p_start = points_c
    resA = INT((dis(x0 - x1, y0 - y1, z0 - z1) + dis(x2 - x3, y2 - y3, z2 - z3)) / 2 / res)
    resB = INT((dis(x0 - x2, y0 - y2, z0 - z2) + dis(x1 - x3, y1 - y3, z1 - z3)) / 2 / res)
    FOR a = 0 TO resA - 1: n = 1 / resA * a
        tx1 = scale(x0, x1, n): ty1 = scale(y0, y1, n): tz1 = scale(z0, z1, n): tx2 = scale(x2, x3, n): ty2 = scale(y2, y3, n): tz2 = scale(z2, z3, n)
        FOR b = 0 TO resB - 1: n = 1 / resB * b: l = p_start + b * resA + a
            points(l, 0) = scale(tx1, tx2, n): points(l, 2) = scale(ty1, ty2, n): points(l, 1) = scale(tz1, tz2, n)
            points(l, 6) = 1: points(l, 7) = acc: points(l, 14) = 1: IF (a = 0 OR a = resA - 1) AND (b = 0 OR b = resB - 1) THEN points(l, 14) = 0
    NEXT b, a
    FOR ty = 0 TO resB - 1: FOR tx = 0 TO resA - 2: p1 = tx + ty * resA: conn_add p1, p1 + 1, tightness: NEXT tx, ty
    FOR tx = 0 TO resA - 1: FOR ty = 0 TO resB - 2: p1 = tx + ty * resA: conn_add p1, p1 + resA, tightness: NEXT ty, tx
    points_c = points_c + resA * resB
END SUB
 
FUNCTION dis (a, b, c): dis = SQR(a * a + b * b + c * c): END FUNCTION
FUNCTION scale (a, b, n): scale = a + (b - a) * n: END FUNCTION
SUB conn_add (p1, p2, tightness): IF p1 = p2 THEN EXIT SUB
    FOR t = 0 TO conn_c_arr - 1: IF (conn(t, 0) = p1 AND conn(t, 1) = p2) OR (conn(t, 0) = p2 AND conn(t, 1) = p1) THEN EXIT SUB
    NEXT t: REDIM disx(2): conn(conn_c, 0) = p1: conn(conn_c, 1) = p2
    FOR t = 0 TO 2: conn(conn_c, 4 + t) = (ABS(points(p1, t) - points(p2, t))) * tightness: NEXT t
    conn(conn_c, 2) = dis(conn(conn_c, 4), conn(conn_c, 5), conn(conn_c, 6)): conn(conn_c, 3) = 1: conn_c = conn_c + 1
END SUB
SUB rotate_2d (x, y, ang): x1 = x * COS(ang) - y * SIN(ang): y1 = x * SIN(ang) + y * COS(ang): x = x1: y = y1: END SUB
SUB rotate_display (x, y, z)
    x = (x - cam(0)) * 100: y = (y - cam(2)) * 100: z = -(z - cam(1)) * 100: rotate_2d x, z, cam(13): rotate_2d y, z, cam(14)
END SUB
FUNCTION degree (a, b): degreex = ATN(a / (b + .00001)) / pip180: degreex = degreex - 180 * ABS(0 > b): degreex = degreex - 360 * (degreex < 0): degree = degreex: END FUNCTION
 
 
 
 
 
'POINTS array
'0,1,2 : X,Y,Z
'3,4,5 : X,Y,Z vector
'6:active 7:identifier
'8,9,10 :X,Y,Z calculated to maptriangle
'11,12,13 :X,Y,Z moving temporary calculating
'14: 0:FIX 1:MOVING
 
 
'CONN array
'0:point#1
'1:point#2
'2:distance
'3:active
'4:disX
'5:disY
'6:disZ
 
 
 
 
 
 

Title: Re: Garland of pearls
Post by: MasterGy on April 05, 2022, 03:32:44 pm

I added another curiosity. (but I haven't covered the point yet)
I recently had a question with _MAPTRIANGLE that calculates 2d points. I wanted to know so I could move with a mouse in 3d. This has now been achieved with a simple solution.
Stretched mesh in 3d. Walkable with WASD + mouse like in 3D games. If you press the Q key, you can grab the point with the mouse and move it. You can nail it with the SPACE key.

Code: QB64: [Select]

mouse_sens = .5
tightness = 1
gravity = .005
lass = .94
power = -0.3
adj = .8 'moving speed 3d point mouse
 
 
RANDOMIZE TIMER
CONST pip180 = 3.141592 / 180
DIM SHARED monx, mony: monx = 800: mony = monx / _DESKTOPWIDTH * _DESKTOPHEIGHT: mon = _NEWIMAGE(monx, mony, 32): SCREEN mon: _FULLSCREEN: _MOUSEHIDE
 
DIM SHARED points_c_arr, conn_c_arr
points_c_arr = 2000
conn_c_arr = 2000
 
DIM SHARED points(points_c_arr, 19), conn(conn_c_arr, 9), cam(19), me(19), conn_c, points_c
 
 
make_grid 1, -10, -10, 10, 10, -10, 0, -10, 10, 0, 10, 10, 0, 1.5
 
 
 
 
 
DO: _LIMIT 30
 
    'control
    mousex = 0: mousey = 0: mw = 0: WHILE _MOUSEINPUT: mousex = mousex + _MOUSEMOVEMENTX: mousey = mousey + _MOUSEMOVEMENTY: mw = mw + _MOUSEWHEEL: WEND
    k_left = _KEYDOWN(19200) OR _KEYDOWN(ASC("a")): k_right = _KEYDOWN(19712) OR _KEYDOWN(ASC("d")): inkey2$ = INKEY$: IF inkey2$ = CHR$(27) THEN END
    k_up = _KEYDOWN(18432) OR _KEYDOWN(ASC("w")): k_down = _KEYDOWN(20480) OR _KEYDOWN(ASC("s")): key_take = _KEYDOWN(ASC("q"))
    me(2) = me(2) + mw: IF key_take THEN _MOUSESHOW ELSE _MOUSEHIDE
    IF key_take = 0 THEN me(3) = me(3) - mousex * mouse_sens: me(4) = me(4) + mousey * mouse_sens: IF ABS(me(4)) > 80 THEN me(4) = 80 * SGN(me(4))
    go = -.5 * ABS(k_left OR k_right OR k_up OR k_down): go_ang = -90 * (k_left - k_right) + (me(3)) - 90
    ang1 = go_ang * pip180: ang2 = (90 - me(4)) * pip180: IF k_down THEN go = -go
    me(0) = me(0) + SIN(ang2) * COS(ang1) * go: me(1) = me(1) + SIN(ang2) * SIN(ang1) * go: me(2) = me(2) + COS(ang2) * go
    FOR t = 0 TO 9: cam(t) = me(t): NEXT t: cam(13) = cam(3) * pip180: cam(14) = cam(4) * pip180
 
 
 
    'calculate moving
    FOR a = 0 TO points_c_arr - 1: FOR t = 0 TO 2: points(a, 11 + t) = points(a, t): NEXT t
        IF (points(a, 14) = 0 OR points(a, 6) = 0) OR a = take_moving THEN _CONTINUE
 
        'connections vector
        vec(0) = 0: vec(1) = 0: vec(2) = 0: vec_c = 0
        FOR t = 0 TO conn_c - 1: IF conn(t, 3) = 0 THEN _CONTINUE
            x = -1: FOR t2 = 0 TO 1: IF conn(t, t2) = a THEN x = conn(t, t2 XOR 1)
            NEXT t2
            IF x <> -1 THEN
                FOR av = 0 TO 2: disv = points(a, av) - points(x, av): vec(av) = vec(av) + ((ABS(disv) - conn(t, 4 + av))) * SGN(disv) * power
                NEXT av: vec_c = vec_c + 1
            END IF
        NEXT t
 
        FOR av = 0 TO 2: points(a, 3 + av) = (points(a, 3 + av) + vec(av) / vec_c) * lass: NEXT av: points(a, 4) = points(a, 4) - gravity
        FOR av = 0 TO 2: points(a, 11 + av) = points(a, av) + points(a, 3 + av): NEXT av
    NEXT a
 
    FOR a = 0 TO points_c_arr - 1: FOR t = 0 TO 2: points(a, t) = points(a, 11 + t): NEXT t, a
 
 
 
    'calculating points
    FOR ap = 0 TO points_c_arr - 1: IF points(ap, 6) = 0 THEN _CONTINUE
        points(ap, 8) = points(ap, 0): points(ap, 9) = points(ap, 1): points(ap, 10) = points(ap, 2)
        rotate_display points(ap, 8), points(ap, 9), points(ap, 10)
        FOR t = 0 TO 2: points(ap, 15 + t) = points(ap, 8 + t): NEXT t: point3d_to_pset points(ap, 15), points(ap, 16), points(ap, 17)
    NEXT ap
 
    'draw connections
    FOR ac = 0 TO conn_c_arr - 1: IF conn(ac, 3) = 0 THEN _CONTINUE
        FOR t1 = 0 TO 1: FOR t2 = 0 TO 2: coo(t1, t2) = points(conn(ac, t1), 15 + t2): NEXT t2, t1
        IF points(conn(ac, 0), 10) < -1 AND points(conn(ac, 1), 10) < -1 THEN
            LINE (coo(0, 0), coo(0, 1))-(coo(1, 0), coo(1, 1)), _RGB32(coo(0, 2), coo(0, 2), coo(0, 2))
        END IF
    NEXT ac
 
    'fix points draw signal
    FOR ap = 0 TO points_c_arr - 1: IF points(ap, 6) = 0 OR points(ap, 14) OR points(ap, 10) > -1 THEN _CONTINUE
        CIRCLE (points(ap, 15), points(ap, 16)), 12000 / points(ap, 10), _RGB32(points(ap, 17), points(ap, 17), points(ap, 17))
    NEXT ap
 
    'take point with mouse
    IF key_take AND take_moving = -1 THEN
        take_sens = monx * 0.01: mindis = 999999: take = -1
        FOR ap = 0 TO points_c_arr - 1: IF points(ap, 6) = 0 OR points(ap, 10) > -1 THEN _CONTINUE
            disx = ABS(_MOUSEX - points(ap, 15)): IF disx > take_sens THEN _CONTINUE
            disy = ABS(_MOUSEY - points(ap, 16)): IF disy > take_sens THEN _CONTINUE
            disv = dis(disx, disy, 0): IF disv > take_sens OR disv > mindis THEN _CONTINUE
        take = ap: mindis = disv: NEXT ap: IF take <> -1 THEN CIRCLE (points(take, 15), points(take, 16)), 5000 / points(take, 10), _RGB32(255, 0, 0)
    END IF
    IF _MOUSEBUTTON(1) = 0 OR key_take = 0 THEN take_moving = -1
    IF key_take AND _MOUSEBUTTON(1) AND take_moving = -1 AND take <> -1 THEN take_moving = take: dis_take = dis(points(take, 8), points(take, 9), points(take, 10))
    IF take <> -1 AND inkey2$ = " " THEN points(take, 14) = points(take, 14) XOR 1
 
    'move with mouse 3d point
    IF take_moving <> -1 THEN
        IF dis(_MOUSEX - points(take_moving, 15), _MOUSEY - points(take_moving, 16), 0) > 20 THEN
            mindis = 99999: FOR ang1 = 0 TO 360 * pip180 STEP 10 * pip180: FOR ang2 = 0 TO 180 * pip180 STEP 10 * pip180
                    px = points(take_moving, 0) + adj * SIN(ang2) * COS(ang1): py = points(take_moving, 1) + adj * SIN(ang2) * SIN(ang1)
                    pz = points(take_moving, 2) + adj * COS(ang2): vx = px: vy = py: vz = pz
                    rotate_display vx, vy, vz: IF ABS(dis(vx, vy, vz) - dis_take) > 300 THEN _CONTINUE
                    point3d_to_pset vx, vy, vz: disx = dis(_MOUSEX - vx, _MOUSEY - vy, 0)
                    IF disx < mindis THEN mindis = disx: cx = px: cy = py: cz = pz
            NEXT ang2, ang1: points(take_moving, 0) = cx: points(take_moving, 1) = cy: points(take_moving, 2) = cz
        END IF
    END IF
 
    mess$ = "moving WASD+mouse      Q-key fixing and moving point"
    IF key_take THEN mess$ = "SPACE-fix/float point  MOUSEBUTTON - hold point"
    IF take_moving <> -1 THEN mess$ = "moving the point with mouse"
    COLOR _RGB32(200, 200, 200): LOCATE mony / 16 - 2: PRINT mess$;
    _DISPLAY
    CLS
LOOP
 
 
SUB point3d_to_pset (x, y, z): zlimit = -2: x = monx * .5 + (x + zlimit) / -z * 400: y = mony * .5 + (y + zlimit) / z * 400
    z = 255 - ABS(z) * .1: IF z < 10 THEN grey = 10
END SUB
 
SUB make_grid (acc, x0, y0, z0, x1, y1, z1, x2, y2, z2, x3, y3, z3, res): p_start = points_c
    resA = INT((dis(x0 - x1, y0 - y1, z0 - z1) + dis(x2 - x3, y2 - y3, z2 - z3)) / 2 / res)
    resB = INT((dis(x0 - x2, y0 - y2, z0 - z2) + dis(x1 - x3, y1 - y3, z1 - z3)) / 2 / res)
    FOR a = 0 TO resA - 1: n = 1 / resA * a
        tx1 = scale(x0, x1, n): ty1 = scale(y0, y1, n): tz1 = scale(z0, z1, n): tx2 = scale(x2, x3, n): ty2 = scale(y2, y3, n): tz2 = scale(z2, z3, n)
        FOR b = 0 TO resB - 1: n = 1 / resB * b: l = p_start + b * resA + a
            points(l, 0) = scale(tx1, tx2, n): points(l, 2) = scale(ty1, ty2, n): points(l, 1) = scale(tz1, tz2, n)
            points(l, 6) = 1: points(l, 7) = acc: points(l, 14) = 1: IF (a = 0 OR a = resA - 1) AND (b = 0 OR b = resB - 1) THEN points(l, 14) = 0
    NEXT b, a
    FOR ty = 0 TO resB - 1: FOR tx = 0 TO resA - 2: p1 = tx + ty * resA: conn_add p1, p1 + 1, tightness: NEXT tx, ty
    FOR tx = 0 TO resA - 1: FOR ty = 0 TO resB - 2: p1 = tx + ty * resA: conn_add p1, p1 + resA, tightness: NEXT ty, tx
    points_c = points_c + resA * resB
END SUB
 
FUNCTION dis (a, b, c): dis = SQR(a * a + b * b + c * c): END FUNCTION
FUNCTION scale (a, b, n): scale = a + (b - a) * n: END FUNCTION
SUB conn_add (p1, p2, tightness): IF p1 = p2 THEN EXIT SUB
    FOR t = 0 TO conn_c_arr - 1: IF (conn(t, 0) = p1 AND conn(t, 1) = p2) OR (conn(t, 0) = p2 AND conn(t, 1) = p1) THEN EXIT SUB
    NEXT t: REDIM disx(2): conn(conn_c, 0) = p1: conn(conn_c, 1) = p2
    FOR t = 0 TO 2: conn(conn_c, 4 + t) = (ABS(points(p1, t) - points(p2, t))) * tightness: NEXT t
    conn(conn_c, 2) = dis(conn(conn_c, 4), conn(conn_c, 5), conn(conn_c, 6)): conn(conn_c, 3) = 1: conn_c = conn_c + 1
END SUB
SUB rotate_2d (x, y, ang): x1 = x * COS(ang) - y * SIN(ang): y1 = x * SIN(ang) + y * COS(ang): x = x1: y = y1: END SUB
SUB rotate_display (x, y, z)
    x = (x - cam(0)) * 100: y = (y - cam(2)) * 100: z = -(z - cam(1)) * 100: rotate_2d x, z, cam(13): rotate_2d y, z, cam(14)
END SUB
FUNCTION degree (a, b): degreex = ATN(a / (b + .00001)) / pip180: degreex = degreex - 180 * ABS(0 > b): degreex = degreex - 360 * (degreex < 0): degree = degreex: END FUNCTION
 
 
 
 
 
'POINTS array
'0,1,2 : XYZ
'3,4,5 : XYZ vector
'6:active 7:identifier
'8,9,10 :XYZ calculated to maptriangle
'11,12,13 :XYZ moving temporary calculating
'14: 0:FIX 1:MOVING
'15,16,17 2D-X,Y, greyscale
 
 
'CONN array
'0:point#1
'1:point#2
'2:distance
'3:active
'4:disX
'5:disY
'6:disZ
 
 
 
 
 
 

Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: MasterGy on March 21, 2022, 08:12:03 pm