Fidget Spinner

[STxAxTIC]

My two-hour coding blitz of the morning led to this:

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(640, 480, 32)
2.  
3. TYPE Vector
4.     x AS DOUBLE
5.     y AS DOUBLE
6. END TYPE
7.  
8. TYPE Object
9.     Index AS INTEGER
10.     CtrMass AS Vector
11.     CtrRot AS Vector
12.     MOI AS DOUBLE
13.     Length AS INTEGER
14.     Shade AS _UNSIGNED LONG
15.     Omega AS DOUBLE
16. END TYPE
17.  
18. REDIM SHARED Shape(10) AS Object
19. REDIM SHARED PointChain(10, 1000) AS Vector
20.  
21. DIM gravity AS Vector
22. DIM vtemp AS Vector
23.  
24. k = 1
25. Shape(k).Index = 1
26. Shape(k).CtrRot.x = 130
27. Shape(k).CtrRot.y = 130
28. i = 0
29. FOR j = 0 TO 6.28 STEP .01
30.     i = i + 1
31.     r = 100 + 40 * COS(3 * j)
32.     PointChain(k, i).x = 0 + r * COS(j)
33.     PointChain(k, i).y = 0 + r * SIN(j)
34. NEXT
35. Shape(k).Length = i
36. Shape(k).Omega = 0
37. Shape(k).Shade = _RGB(255, 255, 255)
38. CALL CalculateCtrMass(k)
39. CALL CalculateMOI(k)
40.  
41. 'k = 2
42. 'Shape(k).Index = 1
43. 'Shape(k).CtrRot.x = 130
44. 'Shape(k).CtrRot.y = 130
45. 'i = 0
46. 'FOR j = 0 TO 6.28 STEP .01
47. '    i = i + 1
48. '    r = 30
49. '    PointChain(k, i).x = 200 + r * COS(j)
50. '    PointChain(k, i).y = 200 + r * SIN(j)
51. 'NEXT
52. 'Shape(k).Length = i
53. 'Shape(k).Omega = 0
54. 'Shape(k).Shade = _RGB(0, 255, 255)
55. 'CALL CalculateCtrMass(k)
56. 'CALL CalculateMOI(k)
57.  
58. gravity.x = 0
59. gravity.y = -.4
60. DO
61.  
62.     DO WHILE _MOUSEINPUT
63.         x = _MOUSEX
64.         y = _MOUSEY
65.         IF ((x > 0) AND (x < _WIDTH) AND (y > 0) AND (y < _HEIGHT)) THEN
66.             IF (_MOUSEBUTTON(1)) THEN
67.                 x = _MOUSEX - _WIDTH / 2
68.                 y = -_MOUSEY + _HEIGHT / 2
69.                 Shape(1).CtrRot.x = x
70.                 Shape(1).CtrRot.y = y
71.                 CALL CalculateMOI(1)
72.                 Shape(1).Omega = 0
73.             END IF
74.             IF (_MOUSEBUTTON(2)) THEN
75.                 x = _MOUSEX - _WIDTH / 2
76.                 y = -_MOUSEY + _HEIGHT / 2
77.                 vtemp.x = x - Shape(1).CtrMass.x
78.                 vtemp.y = y - Shape(1).CtrMass.y
79.                 CALL TranslateShape(1, vtemp)
80.                 CALL CalculateMOI(1)
81.                 Shape(1).Omega = 0
82.             END IF
83.         END IF
84.     LOOP
85.  
86.     IF (_KEYHIT = 32) THEN
87.         Shape(1).CtrRot.x = 0
88.         Shape(1).CtrRot.y = 0
89.         vtemp.x = 0 - Shape(1).CtrMass.x
90.         vtemp.y = 0 - Shape(1).CtrMass.y
91.         CALL TranslateShape(1, vtemp)
92.         CALL CalculateMOI(1)
93.         Shape(1).Omega = 0
94.         _KEYCLEAR
95.     END IF
96.  
97.     FOR ShapeIndex = 1 TO 2
98.  
99.         dx = Shape(ShapeIndex).CtrMass.x - Shape(ShapeIndex).CtrRot.x
100.         dy = Shape(ShapeIndex).CtrMass.y - Shape(ShapeIndex).CtrRot.y
101.         torque = dx * gravity.y - dy * gravity.x
102.         Shape(ShapeIndex).Omega = Shape(ShapeIndex).Omega + torque / Shape(ShapeIndex).MOI
103.         CALL RotShape(ShapeIndex, Shape(ShapeIndex).CtrRot, Shape(ShapeIndex).Omega)
104.  
105.         LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA(0, 0, 0, 100), BF
106.         LOCATE 1, 1: PRINT "Mouse1 = Change axis  --  Mouse2 = Change position  --  Space = Reset"
107.         FOR i = 1 TO Shape(ShapeIndex).Length
108.             CALL cpset(PointChain(ShapeIndex, i).x, PointChain(ShapeIndex, i).y, Shape(ShapeIndex).Shade)
109.         NEXT
110.         CALL ccircle(Shape(ShapeIndex).CtrMass.x, Shape(ShapeIndex).CtrMass.y, 3, Shape(ShapeIndex).Shade)
111.         CALL ccircle(Shape(ShapeIndex).CtrRot.x, Shape(ShapeIndex).CtrRot.y, 3, Shape(ShapeIndex).Shade)
112.         CALL cline(Shape(ShapeIndex).CtrMass.x, Shape(ShapeIndex).CtrMass.y, Shape(ShapeIndex).CtrRot.x, Shape(ShapeIndex).CtrRot.y, Shape(ShapeIndex).Shade)
113.  
114.     NEXT
115.  
116.     _DISPLAY
117.     _LIMIT 120
118. LOOP
119.  
120. END
121.  
122. SUB CalculateCtrMass (k AS INTEGER)
123.     xx = 0
124.     yy = 0
125.     FOR i = 1 TO Shape(k).Length
126.         xx = xx + PointChain(k, i).x
127.         yy = yy + PointChain(k, i).y
128.     NEXT
129.     Shape(k).CtrMass.x = xx / Shape(k).Length
130.     Shape(k).CtrMass.y = yy / Shape(k).Length
131. END SUB
132.  
133. SUB CalculateMOI (k AS INTEGER)
134.     xx = 0
135.     yy = 0
136.     FOR i = 1 TO Shape(k).Length
137.         xx = xx + (Shape(k).CtrRot.x - PointChain(k, i).x) ^ 2
138.         yy = yy + (Shape(k).CtrRot.y - PointChain(k, i).y) ^ 2
139.     NEXT
140.     Shape(k).MOI = (xx + yy) / Shape(k).Length
141. END SUB
142.  
143. SUB TranslateShape (k AS INTEGER, c AS Vector)
144.     FOR i = 1 TO Shape(k).Length
145.         PointChain(k, i).x = PointChain(k, i).x + c.x
146.         PointChain(k, i).y = PointChain(k, i).y + c.y
147.     NEXT
148.     ' Move center of mass.
149.     Shape(k).CtrMass.x = Shape(k).CtrMass.x + c.x
150.     Shape(k).CtrMass.y = Shape(k).CtrMass.y + c.y
151. END SUB
152.  
153. SUB RotShape (k AS INTEGER, c AS Vector, da AS DOUBLE)
154.     FOR i = 1 TO Shape(k).Length
155.         xx = PointChain(k, i).x - c.x
156.         yy = PointChain(k, i).y - c.y
157.         PointChain(k, i).x = c.x + xx * COS(da) - yy * SIN(da)
158.         PointChain(k, i).y = c.y + yy * COS(da) + xx * SIN(da)
159.     NEXT
160.     ' Move center of mass.
161.     xx = Shape(k).CtrMass.x - c.x
162.     yy = Shape(k).CtrMass.y - c.y
163.     Shape(k).CtrMass.x = c.x + xx * COS(da) - yy * SIN(da)
164.     Shape(k).CtrMass.y = c.y + yy * COS(da) + xx * SIN(da)
165. END SUB
166.  
167. SUB cline (x1, y1, x2, y2, col AS _UNSIGNED LONG)
168.     LINE (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2)-(_WIDTH / 2 + x2, -y2 + _HEIGHT / 2), col
169. END SUB
170.  
171. SUB ccircle (x1, y1, rad, col AS _UNSIGNED LONG)
172.     CIRCLE (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2), rad, col
173. END SUB
174.  
175. SUB cpset (x1, y1, col AS _UNSIGNED LONG)
176.     PSET (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2), col
177. END SUB

[bplus]

Hi Stac,

When are you going to change center of balance to effectively make this a double pendulum? eg make one lobe giantic (sic, I can makeup words too).