« previous next »
Pages: [1] 2   Go Down

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

Logged
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 »
Logged

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
Logged

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!
Logged
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!
Logged

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

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!
Logged

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.
Logged

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

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)
Logged
You're not done when it works, you're done when it's right.
Pages: [1] 2   Go Up
« previous next »