Author Topic: Particle engine  (Read 5408 times)

0 Members and 1 Guest are viewing this topic.

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Particle engine
« on: August 29, 2020, 12:52:12 am »
Inspired by the recent work on fountains... This is a very general particle engine that took a day or two to think about and an hour or two to code, with 50% of that time spent trying to remember how POINT works.

It's not a fountain per se, but could easily be so. It also supports fluid circuits, hydraulics, Brownian pathfinding - use your imagination (and your compiler).

Code: QB64: [Select]
  1. SCREEN _NEWIMAGE(800, 600, 32)
  2.  
  3. TYPE Vector
  4.     x AS DOUBLE
  5.     y AS DOUBLE
  6.  
  7. TYPE Pixel
  8.     active AS INTEGER
  9.     position AS Vector
  10.     velocity AS Vector
  11.     velterm AS DOUBLE
  12.     acceleration AS Vector
  13.     size AS DOUBLE
  14.     shade AS _UNSIGNED LONG
  15.  
  16. DIM SHARED PixelCloud(1000) AS Pixel
  17.  
  18. FOR k = 1 TO UBOUND(PixelCloud)
  19.     PixelCloud(k).active = 1
  20.     PixelCloud(k).size = 3
  21.     PixelCloud(k).acceleration.x = 0
  22.     PixelCloud(k).acceleration.y = 0
  23.     PixelCloud(k).velocity.x = 0
  24.     PixelCloud(k).velocity.y = 0
  25.     'PixelCloud(k).position.x = 2 * PixelCloud(k).size * INT((RND - .5) * .5 * _WIDTH / PixelCloud(k).size)
  26.     'PixelCloud(k).position.y = 2 * PixelCloud(k).size * INT((RND - .5) * .5 * _HEIGHT / PixelCloud(k).size)
  27.     PixelCloud(k).position.x = (RND - .5) * _WIDTH
  28.     PixelCloud(k).position.y = (RND - .5) * _HEIGHT
  29.     PixelCloud(k).shade = _RGBA(0, 0, 255, 100)
  30.  
  31. DIM whirlyparameter AS DOUBLE
  32. whirlyparameter = 0
  33.  
  34.     CLS
  35.     CALL DrawBorder
  36.     CALL DrawPixels
  37.     whirlyparameter = whirlyparameter + .025
  38.     CALL clinebf(-100 + 100 * COS(whirlyparameter), 0, -100 + 100 * COS(whirlyparameter) + 5, -250, _RGBA(255, 255, 255, 255))
  39.     CALL clinebf(100, -150 + 100 * COS(whirlyparameter), 300, -150 + 100 * COS(whirlyparameter) + 5, _RGBA(255, 255, 255, 255))
  40.  
  41.     FOR k = 1 TO UBOUND(PixelCloud)
  42.         CALL CalculateInfluence(k)
  43.         CALL UpdatePosition(k)
  44.     NEXT
  45.  
  46.     _DISPLAY
  47.     _LIMIT 30
  48.  
  49.  
  50. SUB UpdatePosition (i AS LONG)
  51.     DIM dt AS DOUBLE
  52.     DIM damp AS DOUBLE
  53.     dt = 2
  54.     damp = .01
  55.     PixelCloud(i).velocity.x = damp * PixelCloud(i).velocity.x + dt * PixelCloud(i).acceleration.x
  56.     PixelCloud(i).velocity.y = damp * PixelCloud(i).velocity.y + dt * PixelCloud(i).acceleration.y
  57.     PixelCloud(i).position.x = PixelCloud(i).position.x + dt * PixelCloud(i).velocity.x
  58.     PixelCloud(i).position.y = PixelCloud(i).position.y + dt * PixelCloud(i).velocity.y
  59.  
  60. SUB CalculateInfluence (i AS LONG)
  61.     DIM x AS DOUBLE
  62.     DIM y AS DOUBLE
  63.     DIM dx AS DOUBLE
  64.     DIM dy AS DOUBLE
  65.     DIM wht(9) AS INTEGER
  66.     x = PixelCloud(i).position.x
  67.     y = PixelCloud(i).position.y
  68.     dx = 2 * PixelCloud(i).size
  69.     dy = 2 * PixelCloud(i).size
  70.     wht(7) = _BLUE32(cpoint(x - dx, y + dy))
  71.     wht(8) = _BLUE32(cpoint(x, y + dy))
  72.     wht(9) = _BLUE32(cpoint(x + dx, y + dy))
  73.     wht(4) = _BLUE32(cpoint(x - dx, y))
  74.     wht(6) = _BLUE32(cpoint(x + dx, y))
  75.     wht(1) = _BLUE32(cpoint(x - dx, y - dy))
  76.     wht(2) = _BLUE32(cpoint(x, y - dy))
  77.     wht(3) = _BLUE32(cpoint(x + dx, y - dy))
  78.     x = wht(6) - wht(4) + (wht(9) + wht(3)) / SQR(2) - (wht(7) + wht(1)) / SQR(2)
  79.     y = wht(8) - wht(2) + (wht(7) + wht(9)) / SQR(2) - (wht(1) + wht(3)) / SQR(2)
  80.     y = y + .5
  81.     IF ((ABS(x) < .001) AND (ABS(y) < .001)) THEN
  82.         PixelCloud(i).acceleration.x = 0
  83.         PixelCloud(i).acceleration.y = 0
  84.     ELSE
  85.         PixelCloud(i).acceleration.x = -x / SQR(x * x + y * y)
  86.         PixelCloud(i).acceleration.y = -y / SQR(x * x + y * y)
  87.     END IF
  88.  
  89. SUB DrawBorder
  90.     LINE (0, 0)-(_WIDTH, _HEIGHT), _RGB32(0, 0, 255, 255), BF
  91.     LINE (10, 10)-(_WIDTH - 10, _HEIGHT - 10), _RGB32(0, 0, 0, 255), BF
  92.  
  93. SUB DrawPixels
  94.     DIM k AS LONG
  95.     DIM x AS DOUBLE
  96.     DIM y AS DOUBLE
  97.     DIM s AS DOUBLE
  98.     FOR k = 1 TO UBOUND(PixelCloud)
  99.         IF (PixelCloud(k).active = 1) THEN
  100.             x = PixelCloud(k).position.x
  101.             y = PixelCloud(k).position.y
  102.             s = PixelCloud(k).size
  103.             CALL clinebf(x - s, y - s, x + s, y + s, PixelCloud(k).shade)
  104.         END IF
  105.     NEXT
  106.  
  107. SUB clinebf (x1 AS DOUBLE, y1 AS DOUBLE, x2 AS DOUBLE, y2 AS DOUBLE, col AS _UNSIGNED LONG)
  108.     LINE (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2)-(_WIDTH / 2 + x2 - 0, -y2 + _HEIGHT / 2 + 0), col, BF
  109.  
  110. FUNCTION cpoint& (x1 AS DOUBLE, y1 AS DOUBLE)
  111.     DIM TheReturn AS _UNSIGNED LONG
  112.     TheReturn = POINT(_WIDTH / 2 + x1, -y1 + _HEIGHT / 2)
  113.     cpoint = TheReturn

You're not done when it works, you're done when it's right.

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Particle engine
« Reply #1 on: August 29, 2020, 01:19:07 am »
That is way cool Static. To test it, I added this white vertical bar at the bottom on line 122 in Sub clinebf
Code: QB64: [Select]
  1. LINE (400, 400)-(410, 580), col, BF  
  2.  

Without even using variables for the coordinates, it stops the water. :) POINT is so cool sometimes. Good job in making this!

« Last Edit: August 29, 2020, 01:22:00 am by SierraKen »

Offline Unseen Machine

  • Forum Regular
  • Posts: 158
  • Make the game not the engine!
    • View Profile
Re: Particle engine
« Reply #2 on: August 29, 2020, 10:06:04 am »
@ Stxaxtic

Only one word needed, NICE! Iwas gonna have go at merging your engine with my one but now i'll have an even easier time doing it!

Unseen

Offline Cobalt

  • QB64 Developer
  • Forum Resident
  • Posts: 878
  • At 60 I become highly radioactive!
    • View Profile
Re: Particle engine
« Reply #3 on: August 29, 2020, 01:28:27 pm »
Fascinating... need some 'popping' objects to scatter the pixels a little.

BTW, LngTmNC!
Granted after becoming radioactive I only have a half-life!

FellippeHeitor

  • Guest
Re: Particle engine
« Reply #4 on: August 29, 2020, 01:52:30 pm »
Wow, that's cool!

Offline loudar

  • Newbie
  • Posts: 73
  • improve it bit by bit.
    • View Profile
Re: Particle engine
« Reply #5 on: August 29, 2020, 02:02:54 pm »
Would be interesting to see an adaptation that could work without looking at what's on the screen... But I'd imagine the collision check to be more difficult then
Check out what I do besides coding: http://loudar.myportfolio.com/

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Re: Particle engine
« Reply #6 on: August 29, 2020, 02:45:57 pm »
you might mean like this...?

Code: QB64: [Select]
  1. ' Display
  2. SCREEN _NEWIMAGE(800, 600, 32)
  3. _SCREENMOVE (_DESKTOPWIDTH \ 2 - _WIDTH \ 2) - 3, (_DESKTOPHEIGHT \ 2 - _HEIGHT \ 2) - 29
  4. _TITLE "Collisions - Version 9"
  5.  
  6. ' Meta
  7. start:
  8.  
  9. ' Data structures
  10. TYPE Vector
  11.     x AS DOUBLE
  12.     y AS DOUBLE
  13.  
  14. DIM SHARED vtemp AS Vector
  15.  
  16. ' Object type
  17. TYPE Object
  18.     Centroid AS Vector
  19.     Collisions AS LONG
  20.     CollisionSwitch AS INTEGER
  21.     DeltaO AS DOUBLE
  22.     DeltaV AS Vector
  23.     Diameter AS DOUBLE
  24.     Elements AS INTEGER
  25.     Fixed AS INTEGER
  26.     Mass AS DOUBLE
  27.     MOI AS DOUBLE
  28.     PartialNormal AS Vector
  29.     Omega AS DOUBLE
  30.     Shade AS _UNSIGNED LONG
  31.     Velocity AS Vector
  32.  
  33. ' Object storage
  34. DIM SHARED Shape(300) AS Object
  35. DIM SHARED PointChain(300, 500) AS Vector
  36. DIM SHARED TempChain(300, 500) AS Vector
  37. DIM SHARED ShapeCount AS INTEGER
  38. DIM SHARED SelectedShape AS INTEGER
  39.  
  40. ' Dynamics
  41. DIM SHARED CollisionCount AS INTEGER
  42. DIM SHARED ProximalPairs(300 / 2, 1 TO 2) AS INTEGER
  43. DIM SHARED ProximalPairsCount AS INTEGER
  44. DIM SHARED ContactPoints AS INTEGER
  45. DIM SHARED CPC, FPC, RST, VD, SV AS DOUBLE
  46.  
  47. ' Environment
  48. DIM SHARED ForceField AS Vector ' Ex: gravity
  49.  
  50. ' Initialize
  51. ShapeCount = 0
  52. CollisionCount = 0
  53.  
  54. ' Prompt
  55. CALL cprintstring(16 * 17, "WELCOME!                    ")
  56. CALL cprintstring(16 * 16, "Press 1 for Pool prototype  ")
  57. CALL cprintstring(16 * 15, "Press 2 for Wacky game      ")
  58. CALL cprintstring(16 * 14, "Press 3 for Concentric rings")
  59. CALL cprintstring(16 * 13, "Press 4 for Walls only      ")
  60. CALL cprintstring(16 * 12, "Press 5 for Angle pong game ")
  61.  
  62.     kk = _KEYHIT
  63.     SELECT CASE kk
  64.         CASE ASC("1")
  65.             CALL SetupPoolGame
  66.             EXIT DO
  67.         CASE ASC("2")
  68.             CALL SetupWackyGame
  69.             EXIT DO
  70.         CASE ASC("3")
  71.             CALL SetupRings
  72.             EXIT DO
  73.         CASE ASC("4")
  74.             CALL SetupWallsOnly
  75.             EXIT DO
  76.         CASE ASC("5")
  77.             CALL SetupAnglePong
  78.             EXIT DO
  79.         CASE ELSE
  80.             _KEYCLEAR
  81.     END SELECT
  82.     _LIMIT 30
  83.  
  84. CALL Graphics
  85. CALL cprintstring(-16 * 4, "During Play:")
  86. CALL cprintstring(-16 * 6, "Move mouse to select closest object (by centroid).")
  87. CALL cprintstring(-16 * 7, "Boost velocity with arrow keys or W/S/A/D.        ")
  88. CALL cprintstring(-16 * 8, "Boost angluar velocity with Q/E.                  ")
  89. CALL cprintstring(-16 * 9, "Drag and fling object with Mouse 1.               ")
  90. CALL cprintstring(-16 * 10, "Rotate selected object with Mousewheel.           ")
  91. CALL cprintstring(-16 * 11, "Halt all motion with ESC.                         ")
  92. CALL cprintstring(-16 * 12, "Create new ball with Mouse 2.                     ")
  93. CALL cprintstring(-16 * 13, "Initiate creative mode with SPACE.                ")
  94. CALL cprintstring(-16 * 14, "Restart by pressing R during motion.              ")
  95. CALL cprintstring(-16 * 16, "PRESS ANY KEY TO BEGIN.")
  96.  
  97. ' Main loop
  98.     IF (UserInput = -1) THEN GOTO start
  99.     CALL PairDynamics(CPC, FPC, RST)
  100.     CALL FleetDynamics(VD, SV)
  101.     CALL Graphics
  102.     _LIMIT 120
  103.  
  104.  
  105. FUNCTION UserInput
  106.     TheReturn = 0
  107.     ' Keyboard input
  108.     kk = _KEYHIT
  109.     SELECT CASE kk
  110.         CASE 32
  111.             DO: LOOP UNTIL _KEYHIT
  112.             WHILE _MOUSEINPUT: WEND
  113.             _KEYCLEAR
  114.             CALL cprintstring(16 * 17, "Drag Mouse 1 counter-clockwise to draw a new shape.")
  115.             CALL cprintstring(16 * 16, "Make sure centroid is inside body.                 ")
  116.             CALL NewMouseShape(7.5, 150, 15)
  117.             CLS
  118.         CASE 18432, ASC("w"), ASC("W") ' Up arrow
  119.             Shape(SelectedShape).Velocity.y = Shape(SelectedShape).Velocity.y * 1.05 + 1.5
  120.         CASE 20480, ASC("s"), ASC("S") ' Down arrow
  121.             Shape(SelectedShape).Velocity.y = Shape(SelectedShape).Velocity.y * 0.95 - 1.5
  122.         CASE 19200, ASC("a"), ASC("A") ' Left arrow
  123.             Shape(SelectedShape).Velocity.x = Shape(SelectedShape).Velocity.x * 0.95 - 1.5
  124.         CASE 19712, ASC("d"), ASC("D") ' Right arrow
  125.             Shape(SelectedShape).Velocity.x = Shape(SelectedShape).Velocity.x * 1.05 + 1.5
  126.         CASE ASC("e"), ASC("E")
  127.             Shape(SelectedShape).Omega = Omega * 0.5 - .02
  128.         CASE ASC("q"), ASC("Q")
  129.             Shape(SelectedShape).Omega = Omega * 1.5 + .02
  130.         CASE ASC("r"), ASC("R")
  131.             TheReturn = -1
  132.         CASE 27
  133.             FOR k = 1 TO ShapeCount
  134.                 Shape(k).Velocity.x = .000001 * (RND - .5)
  135.                 Shape(k).Velocity.y = .000001 * (RND - .5)
  136.                 Shape(k).Omega = .000001 * (RND - .5)
  137.             NEXT
  138.     END SELECT
  139.     IF (kk) THEN
  140.         _KEYCLEAR
  141.     END IF
  142.  
  143.     ' Mouse input
  144.     mb = 0
  145.     mxold = 999999999
  146.     myold = 999999999
  147.         x = _MOUSEX
  148.         y = _MOUSEY
  149.         IF (x > 0) AND (x < _WIDTH) AND (y > 0) AND (y < _HEIGHT) THEN
  150.             x = x - (_WIDTH / 2)
  151.             y = -y + (_HEIGHT / 2)
  152.             rmin = 999999999
  153.             FOR k = 1 TO ShapeCount
  154.                 dx = x - Shape(k).Centroid.x
  155.                 dy = y - Shape(k).Centroid.y
  156.                 r2 = dx * dx + dy * dy
  157.                 IF (r2 < rmin) THEN
  158.                     rmin = r2
  159.                     SelectedShape = k
  160.                 END IF
  161.             NEXT
  162.             IF (_MOUSEBUTTON(1)) THEN
  163.                 IF (mb = 0) THEN
  164.                     mb = 1
  165.                     vtemp.x = x - Shape(SelectedShape).Centroid.x
  166.                     vtemp.y = y - Shape(SelectedShape).Centroid.y
  167.                     CALL TranslateShape(SelectedShape, vtemp)
  168.                     Shape(SelectedShape).Velocity.x = 0
  169.                     Shape(SelectedShape).Velocity.y = 0
  170.                     Shape(SelectedShape).Omega = 0
  171.                     mxold = x
  172.                     myold = y
  173.                 END IF
  174.             END IF
  175.             IF (_MOUSEBUTTON(2)) THEN
  176.                 IF (mb = 0) THEN
  177.                     mb = 1
  178.                     CALL NewAutoBall(x, y, 15, 0, 1, 1, 0)
  179.                     _DELAY .1
  180.                 END IF
  181.             END IF
  182.             IF (_MOUSEWHEEL > 0) THEN
  183.                 CALL RotShape(SelectedShape, Shape(SelectedShape).Centroid, -.02 * 8 * ATN(1))
  184.             END IF
  185.             IF (_MOUSEWHEEL < 0) THEN
  186.                 CALL RotShape(SelectedShape, Shape(SelectedShape).Centroid, .02 * 8 * ATN(1))
  187.             END IF
  188.         END IF
  189.     LOOP
  190.     IF ((mxold <> 999999999) AND (myold <> 999999999)) THEN
  191.         Shape(SelectedShape).Velocity.x = x - mxold
  192.         Shape(SelectedShape).Velocity.y = y - myold
  193.     END IF
  194.     UserInput = TheReturn
  195.  
  196. SUB PairDynamics (CoarseProximityConstant AS DOUBLE, FineProximityConstant AS DOUBLE, Restitution AS DOUBLE)
  197.  
  198.     DIM GrossJ(300) AS INTEGER
  199.     DIM GrossK(300) AS INTEGER
  200.     DIM NumJK AS INTEGER
  201.  
  202.     ' Proximity detection
  203.     ProximalPairsCount = 0
  204.     Shape1 = 0
  205.     Shape2 = 0
  206.     FOR j = 1 TO ShapeCount
  207.         Shape(j).CollisionSwitch = 0
  208.         Shape(j).DeltaO = 0
  209.         Shape(j).DeltaV.x = 0
  210.         Shape(j).DeltaV.y = 0
  211.         Shape(j).PartialNormal.x = 0
  212.         Shape(j).PartialNormal.y = 0
  213.         FOR k = j + 1 TO ShapeCount
  214.             dx = Shape(j).Centroid.x - Shape(k).Centroid.x
  215.             dy = Shape(j).Centroid.y - Shape(k).Centroid.y
  216.             dr = SQR(dx * dx + dy * dy)
  217.             IF (dr < (CoarseProximityConstant) * (Shape(j).Diameter + Shape(k).Diameter)) THEN
  218.                 ProximalPairsCount = ProximalPairsCount + 1
  219.                 ProximalPairs(ProximalPairsCount, 1) = j
  220.                 ProximalPairs(ProximalPairsCount, 2) = k
  221.                 Shape1 = j
  222.                 Shape2 = k
  223.             END IF
  224.         NEXT
  225.     NEXT
  226.  
  227.     ContactPoints = 0
  228.  
  229.     IF (ProximalPairsCount > 0) THEN
  230.         FOR n = 1 TO ProximalPairsCount
  231.             Shape1 = ProximalPairs(n, 1)
  232.             Shape2 = ProximalPairs(n, 2)
  233.  
  234.             ' Collision detection
  235.             rmin = 999999999
  236.             ClosestIndex1 = 0
  237.             ClosestIndex2 = 0
  238.             NumJK = 0
  239.             FOR j = 1 TO Shape(Shape1).Elements
  240.                 FOR k = 1 TO Shape(Shape2).Elements
  241.                     dx = PointChain(Shape1, j).x - PointChain(Shape2, k).x
  242.                     dy = PointChain(Shape1, j).y - PointChain(Shape2, k).y
  243.                     r2 = dx * dx + dy * dy
  244.  
  245.                     IF (r2 <= FineProximityConstant) THEN
  246.  
  247.                         ContactPoints = ContactPoints + 1
  248.  
  249.                         ' Partial normal vector 1
  250.                         nx1 = CalculateNormalY(Shape1, j)
  251.                         ny1 = -CalculateNormalX(Shape1, j)
  252.                         nn = SQR(nx1 * nx1 + ny1 * ny1)
  253.                         nx1 = nx1 / nn
  254.                         ny1 = ny1 / nn
  255.                         Shape(Shape1).PartialNormal.x = Shape(Shape1).PartialNormal.x + nx1
  256.                         Shape(Shape1).PartialNormal.y = Shape(Shape1).PartialNormal.y + ny1
  257.  
  258.                         ' Partial normal vector 2
  259.                         nx2 = CalculateNormalY(Shape2, k)
  260.                         ny2 = -CalculateNormalX(Shape2, k)
  261.                         nn = SQR(nx2 * nx2 + ny2 * ny2)
  262.                         nx2 = nx2 / nn
  263.                         ny2 = ny2 / nn
  264.                         Shape(Shape2).PartialNormal.x = Shape(Shape2).PartialNormal.x + nx2
  265.                         Shape(Shape2).PartialNormal.y = Shape(Shape2).PartialNormal.y + ny2
  266.  
  267.                         NumJK = NumJK + 1
  268.                         GrossJ(NumJK) = j
  269.                         GrossK(NumJK) = k
  270.  
  271.                     END IF
  272.                     IF (r2 < rmin) THEN
  273.                         rmin = r2
  274.                         ClosestIndex1 = j
  275.                         ClosestIndex2 = k
  276.                     END IF
  277.                 NEXT
  278.             NEXT
  279.  
  280.             IF (NumJK > 1) THEN
  281.                 IF ((GrossJ(1) - GrossJ(NumJK)) * (GrossJ(1) - GrossJ(NumJK)) > 50) THEN
  282.                     'ClosestIndex1 = 1
  283.                 ELSE
  284.                     ClosestIndex1 = INT(IntegrateArray(GrossJ(), NumJK) / NumJK)
  285.                 END IF
  286.                 IF ((GrossK(1) - GrossK(NumJK)) * (GrossK(1) - GrossK(NumJK)) > 50) THEN
  287.                     'ClosestIndex2 = 1
  288.                 ELSE
  289.                     ClosestIndex2 = INT(IntegrateArray(GrossK(), NumJK) / NumJK)
  290.                 END IF
  291.             END IF
  292.  
  293.             IF (rmin <= FineProximityConstant) THEN
  294.  
  295.                 CollisionCount = CollisionCount + 1
  296.                 Shape(Shape1).CollisionSwitch = 1
  297.                 Shape(Shape2).CollisionSwitch = 1
  298.  
  299.                 ' Undo previous motion
  300.                 IF (Shape(Shape1).Collisions = 0) THEN
  301.                     CALL RotShape(Shape1, Shape(Shape1).Centroid, -Shape(Shape1).Omega)
  302.                     vtemp.x = -1 * (Shape(Shape1).Velocity.x)
  303.                     vtemp.y = -1 * (Shape(Shape1).Velocity.y)
  304.                     CALL TranslateShape(Shape1, vtemp)
  305.                 END IF
  306.                 IF (Shape(Shape2).Collisions = 0) THEN
  307.                     CALL RotShape(Shape2, Shape(Shape2).Centroid, -Shape(Shape2).Omega)
  308.                     vtemp.x = -1 * (Shape(Shape2).Velocity.x)
  309.                     vtemp.y = -1 * (Shape(Shape2).Velocity.y)
  310.                     CALL TranslateShape(Shape2, vtemp)
  311.                 END IF
  312.  
  313.                 ' Momentum absorption
  314.                 IF (Shape(Shape1).Collisions = 0) THEN
  315.                     Shape(Shape1).Velocity.x = Shape(Shape1).Velocity.x * Restitution
  316.                     Shape(Shape1).Velocity.y = Shape(Shape1).Velocity.y * Restitution
  317.                 END IF
  318.                 IF (Shape(Shape2).Collisions = 0) THEN
  319.                     Shape(Shape2).Velocity.x = Shape(Shape2).Velocity.x * Restitution
  320.                     Shape(Shape2).Velocity.y = Shape(Shape2).Velocity.y * Restitution
  321.                 END IF
  322.  
  323.                 ' Centroid of object 1 (cx1, cy1)
  324.                 cx1 = Shape(Shape1).Centroid.x
  325.                 cy1 = Shape(Shape1).Centroid.y
  326.  
  327.                 ' Centroid of object 2 (cx2, cy2)
  328.                 cx2 = Shape(Shape2).Centroid.x
  329.                 cy2 = Shape(Shape2).Centroid.y
  330.  
  331.                 ' Contact point on object 1 (px1, py1)
  332.                 px1 = PointChain(Shape1, ClosestIndex1).x
  333.                 py1 = PointChain(Shape1, ClosestIndex1).y
  334.  
  335.                 ' Contact point on object 2 (px2, py2)
  336.                 px2 = PointChain(Shape2, ClosestIndex2).x
  337.                 py2 = PointChain(Shape2, ClosestIndex2).y
  338.  
  339.                 ' Contact-centroid differentials 1 (dx1, dy1)
  340.                 dx1 = px1 - cx1
  341.                 dy1 = py1 - cy1
  342.  
  343.                 ' Contact-centroid differentials 2 (dx2, dy2)
  344.                 dx2 = px2 - cx2
  345.                 dy2 = py2 - cy2
  346.  
  347.                 ' Normal vector 1 (nx1, ny1)
  348.                 nn = SQR(Shape(Shape1).PartialNormal.x * Shape(Shape1).PartialNormal.x + Shape(Shape1).PartialNormal.y * Shape(Shape1).PartialNormal.y)
  349.                 nx1 = Shape(Shape1).PartialNormal.x / nn
  350.                 ny1 = Shape(Shape1).PartialNormal.y / nn
  351.  
  352.                 ' Normal vector 2 (nx2, ny2)
  353.                 nn = SQR(Shape(Shape2).PartialNormal.x * Shape(Shape2).PartialNormal.x + Shape(Shape2).PartialNormal.y * Shape(Shape2).PartialNormal.y)
  354.                 nx2 = Shape(Shape2).PartialNormal.x / nn
  355.                 ny2 = Shape(Shape2).PartialNormal.y / nn
  356.  
  357.                 '''
  358.                 'nx1 = CalculateNormalY(Shape1, ClosestIndex1)
  359.                 'ny1 = -CalculateNormalX(Shape1, ClosestIndex1)
  360.                 'nn = SQR(nx1 * nx1 + ny1 * ny1)
  361.                 'nx1 = nx1 / nn
  362.                 'ny1 = ny1 / nn
  363.  
  364.                 'nx2 = CalculateNormalY(Shape2, ClosestIndex2)
  365.                 'ny2 = -CalculateNormalX(Shape2, ClosestIndex2)
  366.                 'nn = SQR(nx2 * nx2 + ny2 * ny2)
  367.                 'nx2 = nx2 / nn
  368.                 'ny2 = ny2 / nn
  369.                 '''
  370.  
  371.                 ' Perpendicular vector 1 (prx1, pry1)
  372.                 prx1 = -dy1
  373.                 pry1 = dx1
  374.                 pp = SQR(prx1 * prx1 + pry1 * pry1)
  375.                 prx1 = prx1 / pp
  376.                 pry1 = pry1 / pp
  377.  
  378.                 ' Perpendicular vector 2 (prx2, pry2)
  379.                 prx2 = -dy2
  380.                 pry2 = dx2
  381.                 pp = SQR(prx2 * prx2 + pry2 * pry2)
  382.                 prx2 = prx2 / pp
  383.                 pry2 = pry2 / pp
  384.  
  385.                 ' Angular velocity vector 1 (w1, r1, vx1, vy1)
  386.                 w1 = Shape(Shape1).Omega
  387.                 r1 = SQR(dx1 * dx1 + dy1 * dy1)
  388.                 vx1 = w1 * r1 * prx1
  389.                 vy1 = w1 * r1 * pry1
  390.  
  391.                 ' Angular velocity vector 2 (w2, r2, vx2, vy2)
  392.                 w2 = Shape(Shape2).Omega
  393.                 r2 = SQR(dx2 * dx2 + dy2 * dy2)
  394.                 vx2 = w2 * r2 * prx2
  395.                 vy2 = w2 * r2 * pry2
  396.  
  397.                 ' Mass terms (m1, m2, mu)
  398.                 m1 = Shape(Shape1).Mass
  399.                 m2 = Shape(Shape2).Mass
  400.                 mu = 1 / (1 / m1 + 1 / m2)
  401.  
  402.                 ' Re-Calculate moment of inertia (i1, i2)
  403.                 vtemp.x = px1
  404.                 vtemp.y = py1
  405.                 CALL CalculateMOI(Shape1, vtemp)
  406.                 vtemp.x = px2
  407.                 vtemp.y = py2
  408.                 CALL CalculateMOI(Shape2, vtemp)
  409.                 i1 = Shape(Shape1).MOI
  410.                 i2 = Shape(Shape2).MOI
  411.  
  412.                 ' Velocity differentials (v1, v2, dvtx, dvty)
  413.                 vcx1 = Shape(Shape1).Velocity.x
  414.                 vcy1 = Shape(Shape1).Velocity.y
  415.                 vcx2 = Shape(Shape2).Velocity.x
  416.                 vcy2 = Shape(Shape2).Velocity.y
  417.                 vtx1 = vcx1 + vx1
  418.                 vty1 = vcy1 + vy1
  419.                 vtx2 = vcx2 + vx2
  420.                 vty2 = vcy2 + vy2
  421.                 v1 = SQR(vtx1 * vtx1 + vty1 * vty1)
  422.                 v2 = SQR(vtx2 * vtx2 + vty2 * vty2)
  423.                 dvtx = vtx2 - vtx1
  424.                 dvty = vty2 - vty1
  425.  
  426.                 ' Geometry (n1dotdvt, n2dotdvt)
  427.                 n1dotdvt = nx1 * dvtx + ny1 * dvty
  428.                 n2dotdvt = nx2 * dvtx + ny2 * dvty
  429.  
  430.                 ' Momentum exchange (qx1, qy1, qx2, qy2)
  431.                 qx1 = nx1 * 2 * mu * n1dotdvt
  432.                 qy1 = ny1 * 2 * mu * n1dotdvt
  433.                 qx2 = nx2 * 2 * mu * n2dotdvt
  434.                 qy2 = ny2 * 2 * mu * n2dotdvt
  435.  
  436.                 ' Momentum exchange unit vector (qhat)
  437.                 qq = SQR(qx1 * qx1 + qy1 * qy1)
  438.                 IF (qx1 * qx1 > 0.01) THEN
  439.                     qhatx1 = qx1 / qq
  440.                 ELSE
  441.                     qx1 = 0
  442.                     qhatx1 = 0
  443.                 END IF
  444.                 IF (qy1 * qy1 > 0.01) THEN
  445.                     qhaty1 = qy1 / qq
  446.                 ELSE
  447.                     qy1 = 0
  448.                     qhaty1 = 0
  449.                 END IF
  450.                 qq = SQR(qx2 * qx2 + qy2 * qy2)
  451.                 IF (qx2 * qx2 > 0.01) THEN
  452.                     qhatx2 = qx2 / qq
  453.                 ELSE
  454.                     qx2 = 0
  455.                     qhatx2 = 0
  456.                 END IF
  457.                 IF (qy2 * qy2 > 0.01) THEN
  458.                     qhaty2 = qy2 / qq
  459.                 ELSE
  460.                     qy2 = 0
  461.                     qhaty2 = 0
  462.                 END IF
  463.  
  464.                 ' Angular impulse (qdotp)
  465.                 q1dotp1 = qx1 * prx1 + qy1 * pry1
  466.                 q2dotp2 = qx2 * prx2 + qy2 * pry2
  467.  
  468.                 ' Translational impulse (qdotn, ndotrhat, f)
  469.                 q1dotn1 = qhatx1 * nx1 + qhaty1 * ny1
  470.                 q2dotn2 = qhatx2 * nx2 + qhaty2 * ny2
  471.                 n1dotr1hat = (nx1 * dx1 + ny1 * dy1) / r1
  472.                 n2dotr2hat = (nx2 * dx2 + ny2 * dy2) / r2
  473.                 f1 = -q1dotn1 * n1dotr1hat
  474.                 f2 = -q2dotn2 * n2dotr2hat
  475.  
  476.                 ' Special case for shape within shape.
  477.                 np = nx1 * nx2 + ny1 * ny2
  478.                 IF (np > 0) THEN
  479.                     dcx = cx1 - cx2
  480.                     dcy = cy1 - cy2
  481.                     dc = SQR(dcx * dcx + dcy * dcy)
  482.                     IF (dc < (r1 + r2)) THEN
  483.                         IF (m1 > m2) THEN ' This criteria may be bullshit in general but works now.
  484.                             q1dotp1 = -q1dotp1
  485.                             f1 = -f1
  486.                         ELSE
  487.                             q2dotp2 = -q2dotp2
  488.                             f2 = -f2
  489.                         END IF
  490.                     END IF
  491.                 END IF
  492.  
  493.                 ' Angular impulse update (edits omega)
  494.                 Shape(Shape1).DeltaO = Shape(Shape1).DeltaO + r1 * q1dotp1 / i1
  495.                 Shape(Shape2).DeltaO = Shape(Shape2).DeltaO - r2 * q2dotp2 / i2
  496.  
  497.                 ' Linear impulse update (edits velocity)
  498.                 dvx1 = f1 * qx1 / m1
  499.                 dvy1 = f1 * qy1 / m1
  500.                 dvx2 = f2 * qx2 / m2
  501.                 dvy2 = f2 * qy2 / m2
  502.                 dvx1s = dvx1 * dvx1
  503.                 dvy1s = dvy1 * dvy1
  504.                 dvx2s = dvx2 * dvx2
  505.                 dvy2s = dvy2 * dvy2
  506.                 IF ((dvx1s > .001) AND (dvx1s < 50)) THEN
  507.                     Shape(Shape1).DeltaV.x = Shape(Shape1).DeltaV.x + dvx1
  508.                 END IF
  509.                 IF ((dvy1s > .001) AND (dvy1s < 50)) THEN
  510.                     Shape(Shape1).DeltaV.y = Shape(Shape1).DeltaV.y + dvy1
  511.                 END IF
  512.                 IF ((dvx2s > .001) AND (dvx2s < 50)) THEN
  513.                     Shape(Shape2).DeltaV.x = Shape(Shape2).DeltaV.x + dvx2
  514.                 END IF
  515.                 IF ((dvy2s > .001) AND (dvy2s < 50)) THEN
  516.                     Shape(Shape2).DeltaV.y = Shape(Shape2).DeltaV.y + dvy2
  517.                 END IF
  518.  
  519.                 ' External torque (edits omega)
  520.                 torque1 = m1 * (dx1 * ForceField.y - dy1 * ForceField.x)
  521.                 torque2 = m2 * (dx2 * ForceField.y - dy2 * ForceField.x)
  522.                 Shape(Shape1).DeltaO = Shape(Shape1).DeltaO - torque1 / i1
  523.                 Shape(Shape2).DeltaO = Shape(Shape2).DeltaO - torque2 / i2
  524.  
  525.                 ' Separate along normal (edits position)
  526.                 IF (Shape(Shape1).Collisions < 2) THEN ' changed from = 0
  527.                     vtemp.x = -nx1 * (.5 / m1) * (1 * v1 ^ 2 + 1 * w1 ^ 2)
  528.                     vtemp.y = -ny1 * (.5 / m1) * (1 * v1 ^ 2 + 1 * w1 ^ 2)
  529.                     CALL TranslateShape(Shape1, vtemp)
  530.                 END IF
  531.                 IF (Shape(Shape2).Collisions < 2) THEN
  532.                     vtemp.x = -nx2 * (.5 / m2) * (1 * v2 ^ 2 + 1 * w2 ^ 2)
  533.                     vtemp.y = -ny2 * (.5 / m2) * (1 * v2 ^ 2 + 1 * w2 ^ 2)
  534.                     CALL TranslateShape(Shape2, vtemp)
  535.                 END IF
  536.  
  537.                 ' Dent along normal
  538.                 'PointChain(Shape1, ClosestIndex1).x = PointChain(Shape1, ClosestIndex1).x - v1 * nx1 / 2
  539.                 'PointChain(Shape1, ClosestIndex1).y = PointChain(Shape1, ClosestIndex1).y - v1 * ny1 / 2
  540.                 'PointChain(Shape2, ClosestIndex2).x = PointChain(Shape2, ClosestIndex2).x - v2 * nx2 / 2
  541.                 'PointChain(Shape2, ClosestIndex2).y = PointChain(Shape2, ClosestIndex2).y - v2 * ny2 / 2
  542.  
  543.                 ' Feedback
  544.                 IF ((Shape(Shape1).Collisions = 0) AND (Shape(Shape2).Collisions = 0)) THEN
  545.                     CALL snd(100 * (v1 + v2) / 2, .5)
  546.                 END IF
  547.  
  548.             END IF
  549.         NEXT
  550.     END IF
  551.  
  552. SUB FleetDynamics (MotionDamping AS DOUBLE, LowLimitVelocity AS DOUBLE)
  553.  
  554.     FOR ShapeIndex = 1 TO ShapeCount
  555.  
  556.         ' Contact update
  557.         IF (Shape(ShapeIndex).CollisionSwitch = 1) THEN
  558.             Shape(ShapeIndex).Collisions = Shape(ShapeIndex).Collisions + 1
  559.         ELSE
  560.             Shape(ShapeIndex).Collisions = 0
  561.         END IF
  562.  
  563.         IF (Shape(ShapeIndex).Fixed = 0) THEN
  564.  
  565.             ' Angular velocity update
  566.             Shape(ShapeIndex).Omega = Shape(ShapeIndex).Omega + Shape(ShapeIndex).DeltaO
  567.  
  568.             ' Linear velocity update
  569.             Shape(ShapeIndex).Velocity.x = Shape(ShapeIndex).Velocity.x + Shape(ShapeIndex).DeltaV.x
  570.             Shape(ShapeIndex).Velocity.y = Shape(ShapeIndex).Velocity.y + Shape(ShapeIndex).DeltaV.y
  571.  
  572.             IF (Shape(ShapeIndex).Collisions = 0) THEN
  573.                 ' Freefall (if airborne)
  574.                 Shape(ShapeIndex).Velocity.x = Shape(ShapeIndex).Velocity.x + ForceField.x
  575.                 Shape(ShapeIndex).Velocity.y = Shape(ShapeIndex).Velocity.y + ForceField.y
  576.             END IF
  577.  
  578.             IF (Shape(ShapeIndex).Collisions > 2) THEN
  579.                 ' Static friction
  580.                 IF ((Shape(ShapeIndex).Velocity.x * Shape(ShapeIndex).Velocity.x) < LowLimitVelocity) THEN
  581.                     Shape(ShapeIndex).Velocity.x = Shape(ShapeIndex).Velocity.x * .05
  582.                 END IF
  583.                 IF ((Shape(ShapeIndex).Velocity.y * Shape(ShapeIndex).Velocity.y) < LowLimitVelocity) THEN
  584.                     Shape(ShapeIndex).Velocity.y = Shape(ShapeIndex).Velocity.y * .05
  585.                 END IF
  586.                 IF ((Shape(ShapeIndex).Omega * Shape(ShapeIndex).Omega) < .000015 * LowLimitVelocity) THEN
  587.                     Shape(ShapeIndex).Omega = 0
  588.                 END IF
  589.             END IF
  590.  
  591.             ' Rotation update
  592.             CALL RotShape(ShapeIndex, Shape(ShapeIndex).Centroid, Shape(ShapeIndex).Omega)
  593.  
  594.             ' Position update
  595.             CALL TranslateShape(ShapeIndex, Shape(ShapeIndex).Velocity)
  596.  
  597.             ' Motion Damping
  598.             Shape(ShapeIndex).Velocity.x = Shape(ShapeIndex).Velocity.x * MotionDamping
  599.             Shape(ShapeIndex).Velocity.y = Shape(ShapeIndex).Velocity.y * MotionDamping
  600.             Shape(ShapeIndex).Omega = Shape(ShapeIndex).Omega * MotionDamping
  601.  
  602.         ELSE
  603.  
  604.             ' Lock all motion
  605.             Shape(ShapeIndex).Velocity.x = 0
  606.             Shape(ShapeIndex).Velocity.y = 0
  607.             Shape(ShapeIndex).Omega = 0
  608.  
  609.         END IF
  610.     NEXT
  611.  
  612.  
  613. SUB Graphics
  614.     LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA(0, 0, 0, 200), BF
  615.     LOCATE 1, 1: PRINT ProximalPairsCount, CollisionCount, ContactPoints
  616.     FOR ShapeIndex = 1 TO ShapeCount
  617.         FOR i = 1 TO Shape(ShapeIndex).Elements - 1
  618.             CALL cpset(PointChain(ShapeIndex, i).x, PointChain(ShapeIndex, i).y, Shape(ShapeIndex).Shade)
  619.             CALL cline(PointChain(ShapeIndex, i).x, PointChain(ShapeIndex, i).y, PointChain(ShapeIndex, i + 1).x, PointChain(ShapeIndex, i + 1).y, Shape(ShapeIndex).Shade)
  620.             IF (ShapeIndex = SelectedShape) THEN
  621.                 CALL ccircle(PointChain(ShapeIndex, i).x, PointChain(ShapeIndex, i).y, 1, Shape(ShapeIndex).Shade)
  622.             END IF
  623.         NEXT
  624.         CALL cpset(PointChain(ShapeIndex, Shape(ShapeIndex).Elements).x, PointChain(ShapeIndex, Shape(ShapeIndex).Elements).y, Shape(ShapeIndex).Shade)
  625.         CALL cline(PointChain(ShapeIndex, 1).x, PointChain(ShapeIndex, 1).y, PointChain(ShapeIndex, Shape(ShapeIndex).Elements).x, PointChain(ShapeIndex, Shape(ShapeIndex).Elements).y, Shape(ShapeIndex).Shade)
  626.         CALL cline(Shape(ShapeIndex).Centroid.x, Shape(ShapeIndex).Centroid.y, PointChain(ShapeIndex, 1).x, PointChain(ShapeIndex, 1).y, Shape(ShapeIndex).Shade)
  627.         IF (ShapeIndex = SelectedShape) THEN
  628.             CALL ccircle(Shape(ShapeIndex).Centroid.x, Shape(ShapeIndex).Centroid.y, 3, Shape(ShapeIndex).Shade)
  629.             CALL cpaint(Shape(ShapeIndex).Centroid.x, Shape(ShapeIndex).Centroid.y, Shape(ShapeIndex).Shade, Shape(ShapeIndex).Shade)
  630.         END IF
  631.     NEXT
  632.     _DISPLAY
  633.  
  634. FUNCTION IntegrateArray (arr() AS INTEGER, lim AS INTEGER)
  635.     t = 0
  636.     FOR j = 1 TO lim
  637.         t = t + arr(j)
  638.     NEXT
  639.     IntegrateArray = t
  640.  
  641. FUNCTION CalculateNormalX (k AS INTEGER, i AS INTEGER)
  642.     DIM l AS Vector
  643.     DIM r AS Vector
  644.     li = i - 1
  645.     ri = i + 1
  646.     IF (i = 1) THEN li = Shape(k).Elements
  647.     IF (i = Shape(k).Elements) THEN ri = 1
  648.     l.x = PointChain(k, li).x
  649.     r.x = PointChain(k, ri).x
  650.     dx = r.x - l.x
  651.     CalculateNormalX = dx
  652.  
  653. FUNCTION CalculateNormalY (k AS INTEGER, i AS INTEGER)
  654.     DIM l AS Vector
  655.     DIM r AS Vector
  656.     li = i - 1
  657.     ri = i + 1
  658.     IF (i = 1) THEN li = Shape(k).Elements
  659.     IF (i = Shape(k).Elements) THEN ri = 1
  660.     l.y = PointChain(k, li).y
  661.     r.y = PointChain(k, ri).y
  662.     dy = r.y - l.y
  663.     CalculateNormalY = dy
  664.  
  665. SUB CalculateCentroid (k AS INTEGER)
  666.     xx = 0
  667.     yy = 0
  668.     FOR i = 1 TO Shape(k).Elements
  669.         xx = xx + PointChain(k, i).x
  670.         yy = yy + PointChain(k, i).y
  671.     NEXT
  672.     Shape(k).Centroid.x = xx / Shape(k).Elements
  673.     Shape(k).Centroid.y = yy / Shape(k).Elements
  674.  
  675. SUB CalculateDiameter (k AS INTEGER)
  676.     r2max = -1
  677.     FOR i = 1 TO Shape(k).Elements
  678.         xx = Shape(k).Centroid.x - PointChain(k, i).x
  679.         yy = Shape(k).Centroid.y - PointChain(k, i).y
  680.         r2 = xx * xx + yy * yy
  681.         IF (r2 > r2max) THEN
  682.             r2max = r2
  683.         END IF
  684.     NEXT
  685.     Shape(k).Diameter = SQR(r2max)
  686.  
  687. SUB CalculateMass (k AS INTEGER, factor AS DOUBLE)
  688.     aa = 0
  689.     FOR i = 2 TO Shape(k).Elements
  690.         x = PointChain(k, i).x - Shape(k).Centroid.x
  691.         y = PointChain(k, i).y - Shape(k).Centroid.y
  692.         dx = (PointChain(k, i).x - PointChain(k, i - 1).x)
  693.         dy = (PointChain(k, i).y - PointChain(k, i - 1).y)
  694.         da = .5 * (x * dy - y * dx)
  695.         aa = aa + da
  696.     NEXT
  697.     Shape(k).Mass = factor * SQR(aa * aa)
  698.  
  699. SUB CalculateMOI (k AS INTEGER, ctrvec AS Vector)
  700.     xx = 0
  701.     yy = 0
  702.     FOR i = 1 TO Shape(k).Elements
  703.         a = ctrvec.x - PointChain(k, i).x
  704.         b = ctrvec.y - PointChain(k, i).y
  705.         xx = xx + a * a
  706.         yy = yy + b * b
  707.     NEXT
  708.     Shape(k).MOI = SQR((xx + yy) * (xx + yy)) * (Shape(k).Mass / Shape(k).Elements)
  709.  
  710. SUB TranslateShape (k AS INTEGER, c AS Vector)
  711.     FOR i = 1 TO Shape(k).Elements
  712.         PointChain(k, i).x = PointChain(k, i).x + c.x
  713.         PointChain(k, i).y = PointChain(k, i).y + c.y
  714.     NEXT
  715.     Shape(k).Centroid.x = Shape(k).Centroid.x + c.x
  716.     Shape(k).Centroid.y = Shape(k).Centroid.y + c.y
  717.  
  718. SUB RotShape (k AS INTEGER, c AS Vector, da AS DOUBLE)
  719.     FOR i = 1 TO Shape(k).Elements
  720.         xx = PointChain(k, i).x - c.x
  721.         yy = PointChain(k, i).y - c.y
  722.         PointChain(k, i).x = c.x + xx * COS(da) - yy * SIN(da)
  723.         PointChain(k, i).y = c.y + yy * COS(da) + xx * SIN(da)
  724.     NEXT
  725.  
  726. SUB NewAutoBall (x1 AS DOUBLE, y1 AS DOUBLE, r1 AS DOUBLE, r2 AS DOUBLE, pa AS DOUBLE, pb AS DOUBLE, fx AS INTEGER)
  727.     ShapeCount = ShapeCount + 1
  728.     Shape(ShapeCount).Fixed = fx
  729.     Shape(ShapeCount).Collisions = 0
  730.     i = 0
  731.     FOR j = 0 TO (8 * ATN(1)) STEP .02 * 8 * ATN(1)
  732.         i = i + 1
  733.         r = r1 + r2 * COS(pa * j) ^ pb
  734.         PointChain(ShapeCount, i).x = x1 + r * COS(j)
  735.         PointChain(ShapeCount, i).y = y1 + r * SIN(j)
  736.     NEXT
  737.     Shape(ShapeCount).Elements = i
  738.     CALL CalculateCentroid(ShapeCount)
  739.     IF (fx = 0) THEN
  740.         CALL CalculateMass(ShapeCount, 1)
  741.     ELSE
  742.         CALL CalculateMass(ShapeCount, 999999)
  743.     END IF
  744.     CALL CalculateMOI(ShapeCount, Shape(ShapeCount).Centroid)
  745.     CALL CalculateDiameter(ShapeCount)
  746.     Shape(ShapeCount).Velocity.x = 0
  747.     Shape(ShapeCount).Velocity.y = 0
  748.     Shape(ShapeCount).Omega = 0
  749.     IF (fx = 0) THEN
  750.         Shape(ShapeCount).Shade = _RGB(100 + INT(RND * 155), 100 + INT(RND * 155), 100 + INT(RND * 155))
  751.     ELSE
  752.         Shape(ShapeCount).Shade = _RGB(100, 100, 100)
  753.     END IF
  754.     SelectedShape = ShapeCount
  755.  
  756. SUB NewAutoBrick (x1 AS DOUBLE, y1 AS DOUBLE, wx AS DOUBLE, wy AS DOUBLE, ang AS DOUBLE)
  757.     ShapeCount = ShapeCount + 1
  758.     Shape(ShapeCount).Fixed = 1
  759.     Shape(ShapeCount).Collisions = 0
  760.     i = 0
  761.     FOR j = -wy / 2 TO wy / 2 STEP 5
  762.         i = i + 1
  763.         PointChain(ShapeCount, i).x = x1 + wx / 2
  764.         PointChain(ShapeCount, i).y = y1 + j
  765.     NEXT
  766.     FOR j = wx / 2 TO -wx / 2 STEP -5
  767.         i = i + 1
  768.         PointChain(ShapeCount, i).x = x1 + j
  769.         PointChain(ShapeCount, i).y = y1 + wy / 2
  770.     NEXT
  771.     FOR j = wy / 2 TO -wy / 2 STEP -5
  772.         i = i + 1
  773.         PointChain(ShapeCount, i).x = x1 - wx / 2
  774.         PointChain(ShapeCount, i).y = y1 + j
  775.     NEXT
  776.     FOR j = -wx / 2 TO wx / 2 STEP 5
  777.         i = i + 1
  778.         PointChain(ShapeCount, i).x = x1 + j
  779.         PointChain(ShapeCount, i).y = y1 - wy / 2
  780.     NEXT
  781.     Shape(ShapeCount).Elements = i
  782.     CALL CalculateCentroid(ShapeCount)
  783.     CALL CalculateMass(ShapeCount, 99999)
  784.     CALL CalculateMOI(ShapeCount, Shape(ShapeCount).Centroid)
  785.     CALL CalculateDiameter(ShapeCount)
  786.     Shape(ShapeCount).Velocity.x = 0
  787.     Shape(ShapeCount).Velocity.y = 0
  788.     Shape(ShapeCount).Omega = 0
  789.     Shape(ShapeCount).Shade = _RGB(100, 100, 100)
  790.     SelectedShape = ShapeCount
  791.     CALL RotShape(ShapeCount, Shape(ShapeCount).Centroid, ang)
  792.  
  793. SUB NewBrickLine (xi AS DOUBLE, yi AS DOUBLE, xf AS DOUBLE, yf AS DOUBLE, wx AS DOUBLE, wy AS DOUBLE)
  794.     d1 = SQR((xf - xi) ^ 2 + (yf - yi) ^ 2)
  795.     d2 = SQR(wx ^ 2 + wy ^ 2)
  796.     ang = ATN((yf - yi) / (xf - xi))
  797.     f = 1.2 * d2 / d1
  798.     FOR t = 0 TO 1 + f STEP f
  799.         CALL NewAutoBrick(xi * (1 - t) + xf * t, yi * (1 - t) + yf * t, wx, wy, ang)
  800.     NEXT
  801.  
  802. SUB NewMouseShape (rawresolution AS DOUBLE, targetpoints AS INTEGER, smoothiterations AS INTEGER)
  803.     ShapeCount = ShapeCount + 1
  804.     Shape(ShapeCount).Fixed = 0
  805.     Shape(ShapeCount).Collisions = 0
  806.     numpoints = 0
  807.     xold = 999 ^ 999
  808.     yold = 999 ^ 999
  809.     DO
  810.         DO WHILE _MOUSEINPUT
  811.             x = _MOUSEX
  812.             y = _MOUSEY
  813.             IF (x > 0) AND (x < _WIDTH) AND (y > 0) AND (y < _HEIGHT) THEN
  814.                 IF _MOUSEBUTTON(1) THEN
  815.                     x = x - (_WIDTH / 2)
  816.                     y = -y + (_HEIGHT / 2)
  817.                     delta = SQR((x - xold) ^ 2 + (y - yold) ^ 2)
  818.                     IF (delta > rawresolution) AND (numpoints < targetpoints - 1) THEN
  819.                         numpoints = numpoints + 1
  820.                         PointChain(ShapeCount, numpoints).x = x
  821.                         PointChain(ShapeCount, numpoints).y = y
  822.                         CALL cpset(x, y, _RGB(0, 255, 255))
  823.                         xold = x
  824.                         yold = y
  825.                     END IF
  826.                 END IF
  827.             END IF
  828.         LOOP
  829.         _DISPLAY
  830.     LOOP UNTIL NOT _MOUSEBUTTON(1) AND (numpoints > 1)
  831.  
  832.     DO WHILE (numpoints < targetpoints)
  833.         rad2max = -1
  834.         kmax = -1
  835.         FOR k = 1 TO numpoints - 1
  836.             xfac = PointChain(ShapeCount, k).x - PointChain(ShapeCount, k + 1).x
  837.             yfac = PointChain(ShapeCount, k).y - PointChain(ShapeCount, k + 1).y
  838.             rad2 = xfac ^ 2 + yfac ^ 2
  839.             IF rad2 > rad2max THEN
  840.                 kmax = k
  841.                 rad2max = rad2
  842.             END IF
  843.         NEXT
  844.         edgecase = 0
  845.         xfac = PointChain(ShapeCount, numpoints).x - PointChain(ShapeCount, 1).x
  846.         yfac = PointChain(ShapeCount, numpoints).y - PointChain(ShapeCount, 1).y
  847.         rad2 = xfac ^ 2 + yfac ^ 2
  848.         IF (rad2 > rad2max) THEN
  849.             kmax = numpoints
  850.             rad2max = rad2
  851.             edgecase = 1
  852.         END IF
  853.         numpoints = numpoints + 1
  854.         IF (edgecase = 0) THEN
  855.             FOR j = numpoints TO kmax + 1 STEP -1
  856.                 PointChain(ShapeCount, j + 1).x = PointChain(ShapeCount, j).x
  857.                 PointChain(ShapeCount, j + 1).y = PointChain(ShapeCount, j).y
  858.             NEXT
  859.             PointChain(ShapeCount, kmax + 1).x = (1 / 2) * (PointChain(ShapeCount, kmax).x + PointChain(ShapeCount, kmax + 2).x)
  860.             PointChain(ShapeCount, kmax + 1).y = (1 / 2) * (PointChain(ShapeCount, kmax).y + PointChain(ShapeCount, kmax + 2).y)
  861.         ELSE
  862.             PointChain(ShapeCount, numpoints).x = (1 / 2) * (PointChain(ShapeCount, 1).x + PointChain(ShapeCount, numpoints - 1).x)
  863.             PointChain(ShapeCount, numpoints).y = (1 / 2) * (PointChain(ShapeCount, 1).y + PointChain(ShapeCount, numpoints - 1).y)
  864.         END IF
  865.     LOOP
  866.  
  867.     FOR j = 1 TO smoothiterations
  868.         FOR k = 2 TO numpoints - 1
  869.             TempChain(ShapeCount, k).x = (1 / 2) * (PointChain(ShapeCount, k - 1).x + PointChain(ShapeCount, k + 1).x)
  870.             TempChain(ShapeCount, k).y = (1 / 2) * (PointChain(ShapeCount, k - 1).y + PointChain(ShapeCount, k + 1).y)
  871.         NEXT
  872.         FOR k = 2 TO numpoints - 1
  873.             PointChain(ShapeCount, k).x = TempChain(ShapeCount, k).x
  874.             PointChain(ShapeCount, k).y = TempChain(ShapeCount, k).y
  875.         NEXT
  876.         TempChain(ShapeCount, 1).x = (1 / 2) * (PointChain(ShapeCount, numpoints).x + PointChain(ShapeCount, 2).x)
  877.         TempChain(ShapeCount, 1).y = (1 / 2) * (PointChain(ShapeCount, numpoints).y + PointChain(ShapeCount, 2).y)
  878.         PointChain(ShapeCount, 1).x = TempChain(ShapeCount, 1).x
  879.         PointChain(ShapeCount, 1).y = TempChain(ShapeCount, 1).y
  880.         TempChain(ShapeCount, numpoints).x = (1 / 2) * (PointChain(ShapeCount, 1).x + PointChain(ShapeCount, numpoints - 1).x)
  881.         TempChain(ShapeCount, numpoints).y = (1 / 2) * (PointChain(ShapeCount, 1).y + PointChain(ShapeCount, numpoints - 1).y)
  882.         PointChain(ShapeCount, numpoints).x = TempChain(ShapeCount, numpoints).x
  883.         PointChain(ShapeCount, numpoints).y = TempChain(ShapeCount, numpoints).y
  884.     NEXT
  885.  
  886.     Shape(ShapeCount).Elements = numpoints
  887.     CALL CalculateCentroid(ShapeCount)
  888.     CALL CalculateMass(ShapeCount, 1)
  889.     CALL CalculateMOI(ShapeCount, Shape(ShapeCount).Centroid)
  890.     CALL CalculateDiameter(ShapeCount)
  891.     Shape(ShapeCount).Velocity.x = 0
  892.     Shape(ShapeCount).Velocity.y = 0
  893.     Shape(ShapeCount).Omega = 0
  894.     Shape(ShapeCount).Shade = _RGB(100 + INT(RND * 155), 100 + INT(RND * 155), 100 + INT(RND * 155))
  895.     SelectedShape = ShapeCount
  896.  
  897. SUB cline (x1 AS DOUBLE, y1 AS DOUBLE, x2 AS DOUBLE, y2 AS DOUBLE, col AS _UNSIGNED LONG)
  898.     LINE (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2)-(_WIDTH / 2 + x2, -y2 + _HEIGHT / 2), col
  899.  
  900. SUB ccircle (x1 AS DOUBLE, y1 AS DOUBLE, rad AS DOUBLE, col AS _UNSIGNED LONG)
  901.     CIRCLE (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2), rad, col
  902.  
  903. SUB cpset (x1 AS DOUBLE, y1 AS DOUBLE, col AS _UNSIGNED LONG)
  904.     PSET (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2), col
  905.  
  906. SUB cpaint (x1 AS DOUBLE, y1 AS DOUBLE, col1 AS _UNSIGNED LONG, col2 AS _UNSIGNED LONG)
  907.     PAINT (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2), col1, col2
  908.  
  909. SUB cprintstring (y AS DOUBLE, a AS STRING)
  910.     _PRINTSTRING (_WIDTH / 2 - (LEN(a) * 8) / 2, -y + _HEIGHT / 2), a
  911.  
  912. SUB snd (frq AS DOUBLE, dur AS DOUBLE)
  913.     IF ((frq >= 37) AND (frq <= 2000)) THEN
  914.         SOUND frq, dur
  915.     END IF
  916.  
  917. SUB SetupPoolGame
  918.     ' Set external field
  919.     ForceField.x = 0
  920.     ForceField.y = 0
  921.  
  922.     ' Rectangular border
  923.     wx = 42
  924.     wy = 10
  925.     CALL NewBrickLine(-_WIDTH / 2 + wx, _HEIGHT / 2 - wy, _WIDTH / 2 - wx, _HEIGHT / 2 - wy, wx, wy)
  926.     CALL NewBrickLine(-_WIDTH / 2 + wx, -_HEIGHT / 2 + wy, _WIDTH / 2 - wx, -_HEIGHT / 2 + wy, wx, wy)
  927.     wx = 40
  928.     wy = 10
  929.     CALL NewBrickLine(-_WIDTH / 2 + wy, -_HEIGHT / 2 + 2 * wx, -_WIDTH / 2 + wy, _HEIGHT / 2 - 2 * wx, wx, wy)
  930.     CALL NewBrickLine(_WIDTH / 2 - wy, -_HEIGHT / 2 + 2 * wx, _WIDTH / 2 - wy, _HEIGHT / 2 - 2 * wx, wx, wy)
  931.  
  932.     ' Balls (billiard setup)
  933.     x0 = 160
  934.     y0 = 0
  935.     r = 15
  936.     gg = 2 * r + 4
  937.     gx = gg * COS(30 * 3.14159 / 180)
  938.     gy = gg * SIN(30 * 3.14159 / 180)
  939.     CALL NewAutoBall(x0 + 0 * gx, y0 + 0 * gy, r, 0, 1, 1, 0)
  940.     CALL NewAutoBall(x0 + 1 * gx, y0 + 1 * gy, r, 0, 1, 1, 0)
  941.     CALL NewAutoBall(x0 + 1 * gx, y0 - 1 * gy, r, 0, 1, 1, 0)
  942.     CALL NewAutoBall(x0 + 2 * gx, y0 + 2 * gy, r, 0, 1, 1, 0)
  943.     CALL NewAutoBall(x0 + 2 * gx, y0 + 0 * gy, r, 0, 1, 1, 0)
  944.     CALL NewAutoBall(x0 + 2 * gx, y0 - 2 * gy, r, 0, 1, 1, 0)
  945.     CALL NewAutoBall(x0 + 3 * gx, y0 + 3 * gy, r, 0, 1, 1, 0)
  946.     CALL NewAutoBall(x0 + 3 * gx, y0 + 1 * gy, r, 0, 1, 1, 0)
  947.     CALL NewAutoBall(x0 + 3 * gx, y0 - 1 * gy, r, 0, 1, 1, 0)
  948.     CALL NewAutoBall(x0 + 3 * gx, y0 - 3 * gy, r, 0, 1, 1, 0)
  949.     CALL NewAutoBall(x0 + 4 * gx, y0 + 4 * gy, r, 0, 1, 1, 0)
  950.     CALL NewAutoBall(x0 + 4 * gx, y0 + 2 * gy, r, 0, 1, 1, 0)
  951.     CALL NewAutoBall(x0 + 4 * gx, y0 - 0 * gy, r, 0, 1, 1, 0)
  952.     CALL NewAutoBall(x0 + 4 * gx, y0 - 2 * gy, r, 0, 1, 1, 0)
  953.     CALL NewAutoBall(x0 + 4 * gx, y0 - 4 * gy, r, 0, 1, 1, 0)
  954.  
  955.     ' Cue ball
  956.     CALL NewAutoBall(-220, 0, r, 0, 1, 1, 0)
  957.     Shape(ShapeCount).Velocity.x = 10 + 2 * RND
  958.     Shape(ShapeCount).Velocity.y = 1 * (RND - .5)
  959.     Shape(ShapeCount).Shade = _RGB(255, 255, 255)
  960.  
  961.     ' Parameters
  962.     CPC = 1.15
  963.     FPC = 8
  964.     RST = 0.75
  965.     VD = 0.995
  966.     SV = 0
  967.  
  968. SUB SetupWackyGame
  969.     ' Set external field
  970.     ForceField.x = 0
  971.     ForceField.y = -.08
  972.  
  973.     ' Rectangular border
  974.     wx = 42
  975.     wy = 10
  976.     CALL NewBrickLine(-_WIDTH / 2 + wx, _HEIGHT / 2 - wy, _WIDTH / 2 - wx, _HEIGHT / 2 - wy, wx, wy)
  977.     CALL NewBrickLine(-_WIDTH / 2 + wx, -_HEIGHT / 2 + wy, _WIDTH / 2 - wx, -_HEIGHT / 2 + wy, wx, wy)
  978.     wx = 40
  979.     wy = 10
  980.     CALL NewBrickLine(-_WIDTH / 2 + wy, -_HEIGHT / 2 + 2 * wx, -_WIDTH / 2 + wy, _HEIGHT / 2 - 2 * wx, wx, wy)
  981.     CALL NewBrickLine(_WIDTH / 2 - wy, -_HEIGHT / 2 + 2 * wx, _WIDTH / 2 - wy, _HEIGHT / 2 - 2 * wx, wx, wy)
  982.  
  983.     ' Wacky balls
  984.     x0 = -70
  985.     y0 = 120
  986.     r1 = 15
  987.     r2 = 2.5
  988.     gg = 2.5 * (r1 + r2) + 3.5
  989.     gx = gg * COS(30 * 3.14159 / 180)
  990.     gy = gg * SIN(30 * 3.14159 / 180)
  991.     CALL NewAutoBall(x0 + 0 * gx, y0 + 0 * gy, r1, r2, INT(RND * 3) + 1, INT(RND * 1) + 2, 0)
  992.     CALL NewAutoBall(x0 + 1 * gx, y0 + 1 * gy, r1, r2, INT(RND * 3) + 1, INT(RND * 1) + 2, 0)
  993.     CALL NewAutoBall(x0 + 1 * gx, y0 - 1 * gy, r1, r2, INT(RND * 3) + 1, INT(RND * 1) + 2, 0)
  994.     CALL NewAutoBall(x0 + 2 * gx, y0 + 2 * gy, r1, r2, INT(RND * 3) + 1, INT(RND * 1) + 2, 0)
  995.     CALL NewAutoBall(x0 + 2 * gx, y0 + 0 * gy, r1, r2, INT(RND * 3) + 1, INT(RND * 1) + 2, 0)
  996.     CALL NewAutoBall(x0 + 2 * gx, y0 - 2 * gy, r1, r2, INT(RND * 3) + 1, INT(RND * 1) + 2, 0)
  997.     CALL NewAutoBall(x0 + 3 * gx, y0 + 3 * gy, r1, r2, INT(RND * 3) + 1, INT(RND * 1) + 2, 0)
  998.     CALL NewAutoBall(x0 + 3 * gx, y0 + 1 * gy, r1, r2, INT(RND * 3) + 1, INT(RND * 1) + 2, 0)
  999.     CALL NewAutoBall(x0 + 3 * gx, y0 - 1 * gy, r1, r2, INT(RND * 3) + 1, INT(RND * 1) + 2, 0)
  1000.     CALL NewAutoBall(x0 + 3 * gx, y0 - 3 * gy, r1, r2, INT(RND * 3) + 1, INT(RND * 1) + 2, 0)
  1001.  
  1002.     ' Slanted bricks
  1003.     wx = 60
  1004.     wy = 10
  1005.     ww = SQR(wx * wx + wy * wy) * .85
  1006.     CALL NewBrickLine(ww, 0, 100 + ww, 100, wx, wy)
  1007.     CALL NewBrickLine(-ww, 0, -100 - ww, 100, wx, wy)
  1008.  
  1009.     ' Fidget spinner
  1010.     CALL NewAutoBall(-220, 0, 20, 15, 1.5, 2, 0)
  1011.     Shape(ShapeCount).Shade = _RGB(255, 255, 255)
  1012.  
  1013.     ' Parameters
  1014.     CPC = 1.15
  1015.     FPC = 8
  1016.     RST = 0.70
  1017.     VD = 0.995
  1018.     SV = 0.025
  1019.  
  1020. SUB SetupRings
  1021.     ' Set external field
  1022.     ForceField.x = 0
  1023.     ForceField.y = 0
  1024.  
  1025.     ' Rectangular border
  1026.     wx = 42
  1027.     wy = 10
  1028.     CALL NewBrickLine(-_WIDTH / 2 + wx, _HEIGHT / 2 - wy, _WIDTH / 2 - wx, _HEIGHT / 2 - wy, wx, wy)
  1029.     CALL NewBrickLine(-_WIDTH / 2 + wx, -_HEIGHT / 2 + wy, _WIDTH / 2 - wx, -_HEIGHT / 2 + wy, wx, wy)
  1030.     wx = 40
  1031.     wy = 10
  1032.     CALL NewBrickLine(-_WIDTH / 2 + wy, -_HEIGHT / 2 + 2 * wx, -_WIDTH / 2 + wy, _HEIGHT / 2 - 2 * wx, wx, wy)
  1033.     CALL NewBrickLine(_WIDTH / 2 - wy, -_HEIGHT / 2 + 2 * wx, _WIDTH / 2 - wy, _HEIGHT / 2 - 2 * wx, wx, wy)
  1034.  
  1035.     FOR r = 25 TO 175 STEP 25
  1036.         CALL NewAutoBall(0, 0, r, 0, 1, 1, 0)
  1037.     NEXT
  1038.  
  1039.     ' Parameters
  1040.     CPC = 1.15
  1041.     FPC = 8
  1042.     RST = 0.75
  1043.     VD = 0.995
  1044.     SV = 0.025
  1045.  
  1046. SUB SetupWallsOnly
  1047.     ' Set external field
  1048.     ForceField.x = 0
  1049.     ForceField.y = 0 - .08
  1050.  
  1051.     ' Fidget spinner
  1052.     CALL NewAutoBall(-220, 0, 20, 15, 1.5, 2, 0)
  1053.     Shape(ShapeCount).Shade = _RGB(255, 255, 255)
  1054.  
  1055.     ' Rectangular border
  1056.     wx = 42
  1057.     wy = 10
  1058.     CALL NewBrickLine(-_WIDTH / 2 + wx, _HEIGHT / 2 - wy, _WIDTH / 2 - wx, _HEIGHT / 2 - wy, wx, wy)
  1059.     CALL NewBrickLine(-_WIDTH / 2 + wx, -_HEIGHT / 2 + wy, _WIDTH / 2 - wx, -_HEIGHT / 2 + wy, wx, wy)
  1060.     wx = 40
  1061.     wy = 10
  1062.     CALL NewBrickLine(-_WIDTH / 2 + wy, -_HEIGHT / 2 + 2 * wx, -_WIDTH / 2 + wy, _HEIGHT / 2 - 2 * wx, wx, wy)
  1063.     CALL NewBrickLine(_WIDTH / 2 - wy, -_HEIGHT / 2 + 2 * wx, _WIDTH / 2 - wy, _HEIGHT / 2 - 2 * wx, wx, wy)
  1064.  
  1065.     ' Parameters
  1066.     CPC = 1.15
  1067.     FPC = 8
  1068.     RST = 0.75
  1069.     VD = 0.995
  1070.     SV = 0.025
  1071.  
  1072. SUB SetupAnglePong
  1073.     ' Set external field
  1074.     ForceField.x = 0
  1075.     ForceField.y = 0
  1076.  
  1077.     ' Rectangular border
  1078.     wx = 42
  1079.     wy = 10
  1080.     CALL NewBrickLine(-_WIDTH / 2 + wx, _HEIGHT / 2 - wy, _WIDTH / 2 - wx, _HEIGHT / 2 - wy, wx, wy)
  1081.     CALL NewBrickLine(-_WIDTH / 2 + wx, -_HEIGHT / 2 + wy, _WIDTH / 2 - wx, -_HEIGHT / 2 + wy, wx, wy)
  1082.     wx = 40
  1083.     wy = 10
  1084.     CALL NewBrickLine(-_WIDTH / 2 + wy, -_HEIGHT / 2 + 2 * wx, -_WIDTH / 2 + wy, _HEIGHT / 2 - 2 * wx, wx, wy)
  1085.     CALL NewBrickLine(_WIDTH / 2 - wy, -_HEIGHT / 2 + 2 * wx, _WIDTH / 2 - wy, _HEIGHT / 2 - 2 * wx, wx, wy)
  1086.  
  1087.     ' Pong ball
  1088.     CALL NewAutoBall(0, 200, 20, 0, 1, 1, 0)
  1089.     Shape(ShapeCount).Velocity.x = -1
  1090.     Shape(ShapeCount).Velocity.y = -3
  1091.     Shape(ShapeCount).Shade = _RGB(255, 255, 255)
  1092.  
  1093.     ' Pong Paddle
  1094.     CALL NewAutoBrick(-100, 10, 100, -10, -.02 * 8 * ATN(1))
  1095.     vtemp.x = 0
  1096.     vtemp.y = -200
  1097.     CALL TranslateShape(ShapeCount, vtemp)
  1098.     Shape(ShapeCount).Shade = _RGB(200, 200, 200)
  1099.  
  1100.     ' Parameters
  1101.     CPC = 1.15
  1102.     FPC = 8
  1103.     RST = 1 '0.75
  1104.     VD = 1 '0.995
  1105.     SV = 0.025
You're not done when it works, you're done when it's right.

Offline loudar

  • Newbie
  • Posts: 73
  • improve it bit by bit.
    • View Profile
Re: Particle engine
« Reply #7 on: August 29, 2020, 02:49:37 pm »
Just like that! I managed to gave the object so much velocity it clipped through the objects into the depths of the offscreen area :D (in mode 4)
Check out what I do besides coding: http://loudar.myportfolio.com/

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Re: Particle engine
« Reply #8 on: August 29, 2020, 02:54:57 pm »
Not surprised in the sense that there are no safety checks, bumper lanes, handicap ramps, or hand sanitizer stations in that code - just raw collisions. Have you discovered creative mode yet where you draw your own shapes? (Works in all modes actually)
You're not done when it works, you're done when it's right.

FellippeHeitor

  • Guest
Re: Particle engine
« Reply #9 on: August 29, 2020, 02:56:12 pm »
In the meantime: http://discord.qb64.org

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Particle engine
« Reply #10 on: August 29, 2020, 03:11:47 pm »
Wow that Pong version is something!

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Particle engine
« Reply #11 on: August 29, 2020, 03:36:55 pm »
Awesome collisions! Would be interesting to learn how to do a physics engine like that.

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Re: Particle engine
« Reply #12 on: August 29, 2020, 10:12:54 pm »
By no means finished, just found this to be a fun checkpoint. I bring you... the heat pump...

Code: QB64: [Select]
  1. SCREEN _NEWIMAGE(1024, 768, 32)
  2.  
  3. TYPE Vector
  4.     x AS DOUBLE
  5.     y AS DOUBLE
  6.  
  7. TYPE Pixel
  8.     active AS INTEGER
  9.     position AS Vector
  10.     velocity AS Vector
  11.     acceleration AS Vector
  12.     size AS DOUBLE
  13.     shadered AS INTEGER
  14.     shadegreen AS INTEGER
  15.     shadeblue AS INTEGER
  16.     shadealpha AS INTEGER
  17.  
  18. DIM SHARED PixelCloud(3000) AS Pixel
  19.  
  20. FOR k = 1 TO UBOUND(PixelCloud)
  21.     PixelCloud(k).active = 1
  22.     PixelCloud(k).size = 3
  23.     PixelCloud(k).acceleration.x = 0
  24.     PixelCloud(k).acceleration.y = 0
  25.     PixelCloud(k).velocity.x = 0
  26.     PixelCloud(k).velocity.y = 0
  27.     'PixelCloud(k).position.x = 2 * PixelCloud(k).size * INT((RND - .5) * .5 * _WIDTH / PixelCloud(k).size)
  28.     'PixelCloud(k).position.y = 2 * PixelCloud(k).size * INT((RND - .5) * .5 * _HEIGHT / PixelCloud(k).size)
  29.     PixelCloud(k).position.x = (RND - .5) * _WIDTH * .9
  30.     PixelCloud(k).position.y = (RND - .5) * _HEIGHT * .9
  31.     IF RND < 1.5 THEN
  32.         PixelCloud(k).shadered = 0
  33.         PixelCloud(k).shadegreen = 0
  34.         PixelCloud(k).shadeblue = 255
  35.         PixelCloud(k).shadealpha = 150
  36.     ELSE
  37.         PixelCloud(k).shadered = 255
  38.         PixelCloud(k).shadegreen = 0
  39.         PixelCloud(k).shadeblue = 0
  40.         PixelCloud(k).shadealpha = 150
  41.     END IF
  42.  
  43. DIM whirlyparameter AS DOUBLE
  44. whirlyparameter = 0
  45.  
  46.     CLS
  47.     CALL DrawBorder
  48.     CALL DrawPixels
  49.     whirlyparameter = whirlyparameter + .025
  50.     'CALL clinebf(10 - 100 + 100 * COS(whirlyparameter * 0), 0, 10 - 100 + 100 * COS(whirlyparameter * 0) + 8, -250, _RGBA(0, 0, 255, 255))
  51.     CALL clinebf(-100 + 100 * COS(whirlyparameter * 0), 0, -100 + 100 * COS(whirlyparameter * 0) + 8, -250, _RGBA(255, 0, 0, 255))
  52.     CALL clinebf(-150 + 100 * COS(whirlyparameter * 0), 0, -150 + 100 * COS(whirlyparameter * 0) + 8, -250, _RGBA(255, 0, 0, 255))
  53.     'CALL clinebf(-8 - 150 + 100 * COS(whirlyparameter * 0), 0, -8 - 150 + 100 * COS(whirlyparameter * 0) + 8, -250, _RGBA(0, 0, 255, 255))
  54.  
  55.     CALL clinebf(-40, -250 + 100 * SIN(whirlyparameter), 0, -250 + 100 * SIN(whirlyparameter) + 8, _RGBA(0, 255, 0, 255))
  56.  
  57.     FOR k = 1 TO UBOUND(PixelCloud)
  58.         CALL CalculateInfluence(k)
  59.         CALL UpdatePosition(k)
  60.     NEXT
  61.  
  62.     _DISPLAY
  63.     _LIMIT 30
  64.  
  65.  
  66. SUB UpdatePosition (i AS LONG)
  67.     DIM dt AS DOUBLE
  68.     DIM damp AS DOUBLE
  69.     DIM brownian AS DOUBLE
  70.     dt = 2
  71.     damp = .25
  72.     brownian = .25
  73.     PixelCloud(i).velocity.x = damp * PixelCloud(i).velocity.x + dt * PixelCloud(i).acceleration.x
  74.     PixelCloud(i).velocity.y = damp * PixelCloud(i).velocity.y + dt * PixelCloud(i).acceleration.y
  75.     PixelCloud(i).position.x = PixelCloud(i).position.x + dt * PixelCloud(i).velocity.x + (RND - .5) * brownian
  76.     PixelCloud(i).position.y = PixelCloud(i).position.y + dt * PixelCloud(i).velocity.y + (RND - .5) * brownian
  77.     IF (PixelCloud(i).position.y <= -_HEIGHT / 2 + 2 * PixelCloud(i).size + 1) THEN
  78.         PixelCloud(i).position.y = _HEIGHT / 2 - 2 * PixelCloud(i).size
  79.     END IF
  80.  
  81. SUB CalculateInfluence (i AS LONG)
  82.     DIM x AS DOUBLE
  83.     DIM y AS DOUBLE
  84.     DIM xr AS DOUBLE
  85.     DIM yr AS DOUBLE
  86.     DIM xg AS DOUBLE
  87.     DIM yg AS DOUBLE
  88.     DIM xb AS DOUBLE
  89.     DIM yb AS DOUBLE
  90.  
  91.     DIM dx AS DOUBLE
  92.     DIM dy AS DOUBLE
  93.     DIM WPoint(9) AS _UNSIGNED LONG
  94.     DIM WRed(9) AS INTEGER
  95.     DIM WGreen(9) AS INTEGER
  96.     DIM WBlue(9) AS INTEGER
  97.     x = PixelCloud(i).position.x
  98.     y = PixelCloud(i).position.y
  99.     dx = 2 * PixelCloud(i).size
  100.     dy = 2 * PixelCloud(i).size
  101.     WPoint(7) = cpoint(x - dx, y + dy)
  102.     WPoint(8) = cpoint(x, y + dy)
  103.     WPoint(9) = cpoint(x + dx, y + dy)
  104.     WPoint(4) = cpoint(x - dx, y)
  105.     WPoint(6) = cpoint(x + dx, y)
  106.     WPoint(1) = cpoint(x - dx, y - dy)
  107.     WPoint(2) = cpoint(x, y - dy)
  108.     WPoint(3) = cpoint(x + dx, y - dy)
  109.  
  110.     WRed(7) = _RED32(WPoint(7))
  111.     WRed(8) = _RED32(WPoint(8))
  112.     WRed(9) = _RED32(WPoint(9))
  113.     WRed(4) = _RED32(WPoint(4))
  114.     WRed(6) = _RED32(WPoint(6))
  115.     WRed(1) = _RED32(WPoint(1))
  116.     WRed(2) = _RED32(WPoint(2))
  117.     WRed(3) = _RED32(WPoint(3))
  118.     WGreen(7) = _GREEN32(WPoint(7))
  119.     WGreen(8) = _GREEN32(WPoint(8))
  120.     WGreen(9) = _GREEN32(WPoint(9))
  121.     WGreen(4) = _GREEN32(WPoint(4))
  122.     WGreen(6) = _GREEN32(WPoint(6))
  123.     WGreen(1) = _GREEN32(WPoint(1))
  124.     WGreen(2) = _GREEN32(WPoint(2))
  125.     WGreen(3) = _GREEN32(WPoint(3))
  126.     WBlue(7) = _BLUE32(WPoint(7))
  127.     WBlue(8) = _BLUE32(WPoint(8))
  128.     WBlue(9) = _BLUE32(WPoint(9))
  129.     WBlue(4) = _BLUE32(WPoint(4))
  130.     WBlue(6) = _BLUE32(WPoint(6))
  131.     WBlue(1) = _BLUE32(WPoint(1))
  132.     WBlue(2) = _BLUE32(WPoint(2))
  133.     WBlue(3) = _BLUE32(WPoint(3))
  134.  
  135.     xr = (WRed(6) - WRed(4) + (WRed(9) + WRed(3)) / SQR(2) - (WRed(7) + WRed(1)) / SQR(2))
  136.     yr = (WRed(8) - WRed(2) + (WRed(7) + WRed(9)) / SQR(2) - (WRed(1) + WRed(3)) / SQR(2))
  137.     xg = (WGreen(6) - WGreen(4) + (WGreen(9) + WGreen(3)) / SQR(2) - (WGreen(7) + WGreen(1)) / SQR(2))
  138.     yg = (WGreen(8) - WGreen(2) + (WGreen(7) + WGreen(9)) / SQR(2) - (WGreen(1) + WGreen(3)) / SQR(2))
  139.     xb = (WBlue(6) - WBlue(4) + (WBlue(9) + WBlue(3)) / SQR(2) - (WBlue(7) + WBlue(1)) / SQR(2))
  140.     yb = (WBlue(8) - WBlue(2) + (WBlue(7) + WBlue(9)) / SQR(2) - (WBlue(1) + WBlue(3)) / SQR(2))
  141.     x = xr + xg + xb
  142.     y = yr + yg + yb
  143.  
  144.     IF (xr ^ 2 + yr ^ 2 > xb ^ 2 + yb ^ 2) AND (xr ^ 2 + yr ^ 2 > 15) THEN
  145.         PixelCloud(i).shadered = PixelCloud(i).shadered + 128
  146.         IF (PixelCloud(i).shadered >= 255) THEN PixelCloud(i).shadered = 255
  147.         PixelCloud(i).shadeblue = PixelCloud(i).shadeblue - 128
  148.         IF (PixelCloud(i).shadeblue <= 0) THEN PixelCloud(i).shadeblue = 0
  149.     END IF
  150.  
  151.     IF (xb ^ 2 + yb ^ 2 > xr ^ 2 + yr ^ 2) THEN
  152.         PixelCloud(i).shadered = PixelCloud(i).shadered - 128
  153.         IF (PixelCloud(i).shadered <= 0) THEN PixelCloud(i).shadered = 0
  154.         PixelCloud(i).shadeblue = PixelCloud(i).shadeblue + 128
  155.         IF (PixelCloud(i).shadeblue >= 255) THEN PixelCloud(i).shadeblue = 255
  156.     END IF
  157.  
  158.     y = y - 2 * (PixelCloud(i).shadered - PixelCloud(i).shadeblue) / 255
  159.  
  160.     PixelCloud(i).shadered = PixelCloud(i).shadered - 5
  161.     IF (PixelCloud(i).shadered <= 0) THEN PixelCloud(i).shadered = 0
  162.     PixelCloud(i).shadeblue = PixelCloud(i).shadeblue + 5
  163.     IF (PixelCloud(i).shadeblue >= 255) THEN PixelCloud(i).shadeblue = 255
  164.  
  165.  
  166.     IF (ABS(x) < .001) THEN
  167.         PixelCloud(i).acceleration.x = 0
  168.     ELSE
  169.         PixelCloud(i).acceleration.x = -x / SQR(x * x + y * y)
  170.     END IF
  171.     IF (ABS(y) < .001) THEN
  172.         PixelCloud(i).acceleration.y = 0
  173.     ELSE
  174.         PixelCloud(i).acceleration.y = -y / SQR(x * x + y * y)
  175.     END IF
  176.  
  177. SUB DrawBorder
  178.     LINE (0, 0)-(_WIDTH, _HEIGHT), _RGB32(255, 0, 0, 255), BF
  179.     LINE (10, 10)-(_WIDTH - 10, _HEIGHT - 10), _RGB32(0, 0, 0, 255), BF
  180.  
  181. SUB DrawPixels
  182.     DIM k AS LONG
  183.     DIM x AS DOUBLE
  184.     DIM y AS DOUBLE
  185.     DIM s AS DOUBLE
  186.     FOR k = 1 TO UBOUND(PixelCloud)
  187.         IF (PixelCloud(k).active = 1) THEN
  188.             x = PixelCloud(k).position.x
  189.             y = PixelCloud(k).position.y
  190.             s = PixelCloud(k).size
  191.             CALL clinebf(x - s, y - s, x + s, y + s, _RGBA(PixelCloud(k).shadered, PixelCloud(k).shadegreen, PixelCloud(k).shadeblue, PixelCloud(k).shadealpha))
  192.         END IF
  193.     NEXT
  194.  
  195. SUB clinebf (x1 AS DOUBLE, y1 AS DOUBLE, x2 AS DOUBLE, y2 AS DOUBLE, col AS _UNSIGNED LONG)
  196.     LINE (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2)-(_WIDTH / 2 + x2 - 0, -y2 + _HEIGHT / 2 + 0), col, BF
  197.  
  198. FUNCTION cpoint& (x1 AS DOUBLE, y1 AS DOUBLE)
  199.     DIM TheReturn AS _UNSIGNED LONG
  200.     TheReturn = POINT(_WIDTH / 2 + x1, -y1 + _HEIGHT / 2)
  201.     cpoint = TheReturn
« Last Edit: August 29, 2020, 11:16:19 pm by STxAxTIC »
You're not done when it works, you're done when it's right.

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Particle engine
« Reply #13 on: August 29, 2020, 10:57:45 pm »
That is so cool Static! Would be a nice demonstration app for kids to learn about volcanoes.  :)

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Re: Particle engine
« Reply #14 on: August 29, 2020, 11:16:36 pm »
(edited the above to make it look cooler)
You're not done when it works, you're done when it's right.