Enclose a Random Set of Points, Voronoi to Border

[bplus]

Code: QB64: [Select]

1. _TITLE "Enclose a random set of points then Voronoi to border"
2. RANDOMIZE TIMER
3. CONST xmax = 800
4. CONST ymax = 600
5. SCREEN _NEWIMAGE(xmax, ymax, 32)
6. _SCREENMOVE 300, 20
7.  
8. TYPE PointType
9.     x AS INTEGER
10.     y AS INTEGER
11.     K AS _UNSIGNED LONG
12.     connectX AS INTEGER
13.     connectY AS INTEGER
14. END TYPE
15. DIM SHARED dotsBg&, nPoints
16. dotsBg& = _NEWIMAGE(xmax, ymax, 32)
17. nPoints = 13 '<<<<<<<<<<< actually less points makes for more interesting shapes!
18. REDIM SHARED p(1 TO nPoints) AS PointType
19. WHILE _KEYDOWN(27) = 0
20.     REDIM p(1 TO nPoints) AS PointType
21.     _DEST dotsBg&
22.     CLS
23.     FOR i = 1 TO nPoints
24.  
25.         'test circle points, supposed to be most difficult
26.         'toggle comments this whole block to try random dots or dots on a circle
27.  
28.         'ca = _PI(2 / (nPoints - 1))
29.         'IF i = 1 THEN 'need one off the border for painting interior
30.         '    p(i).x = xmax / 2: p(i).y = ymax / 2
31.         'ELSE
32.         '    p(i).x = xmax / 2 + 200 * COS(ca * i)
33.         '    p(i).y = ymax / 2 + 200 * SIN(ca * i)
34.         'END IF
35.         p(i).x = INT(RND * (xmax - 20)) + 10
36.         p(i).y = INT(RND * (ymax - 20)) + 10
37.  
38.  
39.         p(i).K = _RGB32(200 * RND + 30, 200 * RND + 20, 200 * RND + 10)
40.         fcirc p(i).x, p(i).y, 2, p(i).K
41.     NEXT
42.     _DEST 0
43.     qSort 1, nPoints, p()
44.     curPoint = 1
45.     plot
46.     _DELAY 1
47.     'main event: going from farthest left to right find points that contiain interior with convex polygon
48.     'This loop does the top section
49.     DO
50.         lowestAngle = _PI(2): saveI = 0
51.         FOR i = curPoint + 1 TO nPoints
52.             testAngle = _ATAN2(p(i).y - p(curPoint).y, p(i).x - p(curPoint).x)
53.             IF testAngle < lowestAngle THEN lowestAngle = testAngle: saveI = i
54.         NEXT
55.         IF saveI THEN
56.             p(curPoint).connectX = p(saveI).x: p(curPoint).connectY = p(saveI).y
57.             curPoint = saveI
58.         ELSE 'point B
59.             PRINT "Screwed!"
60.             _DISPLAY
61.             EXIT DO
62.         END IF
63.         plot
64.         _DISPLAY
65.         _LIMIT 1
66.     LOOP UNTIL curPoint = nPoints
67.  
68.     'main even part 2: going back right to left find the points that contain the interior with a convex ploygon
69.     'This loop does the bottom section
70.     curPoint = nPoints
71.     DO
72.         lowestAngle = _PI(2): saveI = 0
73.         FOR i = curPoint - 1 TO 1 STEP -1
74.             testAngle = _ATAN2(p(curPoint).y - p(i).y, p(curPoint).x - p(i).x)
75.             IF testAngle < lowestAngle THEN lowestAngle = testAngle: saveI = i
76.         NEXT
77.         IF saveI THEN
78.             p(curPoint).connectX = p(saveI).x: p(curPoint).connectY = p(saveI).y
79.             curPoint = saveI
80.         ELSE 'point B
81.             PRINT "Screwed!"
82.             _DISPLAY
83.             EXIT DO
84.         END IF
85.         plot
86.         _DISPLAY
87.         _LIMIT 1
88.     LOOP UNTIL curPoint = 1
89.  
90.     'note: if a dot happens to sit on the border the paint is going to leak blue
91.     ' FIXED dots are on separate Bg image
92.  
93.     ' find an interior point (not connected) and paint from there
94.     FOR i = 1 TO nPoints
95.         IF p(i).connectX = 0 THEN PAINT (p(i).x, p(i).y), _RGB32(0, 0, 255), _RGB32(255, 255, 255)
96.     NEXT
97.  
98.     'the blue paint is to tell us which points to Voronoi
99.     maxD = xmax + ymax
100.     FOR x = p(1).x TO p(nPoints).x
101.         FOR y = 0 TO ymax
102.             IF POINT(x, y) = _RGB32(0, 0, 255) THEN 'a Voronoi point to color the same as closest point
103.                 d = maxD
104.                 FOR i = 1 TO nPoints 'looking for closet point to x, y
105.                     a = ABS(p(i).x - x)
106.                     b = ABS(p(i).y - y)
107.                     IF a + b < d THEN d = a + b: kkl = i
108.                 NEXT
109.                 PSET (x, y), p(kkl).K 'set x, y the same as closets point color
110.             END IF
111.         NEXT
112.         _DISPLAY
113.     NEXT
114.     _DELAY 5
115. WEND
116.  
117. SUB plot
118.     CLS
119.     _PUTIMAGE , dotsBg&, 0 'dots were causing Paints to bleed
120.     FOR i = 1 TO nPoints
121.         'note x can not = 0
122.         IF p(i).connectX THEN thic p(i).x, p(i).y, p(i).connectX, p(i).connectY, 1, _RGB32(255, 255, 255)
123.     NEXT
124.     _PRINTSTRING (5, 5), "Points:" + STR$(nPoints)
125. END SUB
126.  
127. 'now scan or sort on x
128. SUB qSort (start AS LONG, finish AS LONG, a() AS PointType)
129.     DIM Hi AS LONG, Lo AS LONG, Middle AS INTEGER
130.     Hi = finish: Lo = start
131.     Middle = a((Lo + Hi) / 2).x 'find middle of array
132.     DO
133.         DO WHILE a(Lo).x < Middle: Lo = Lo + 1: LOOP
134.         DO WHILE a(Hi).x > Middle: Hi = Hi - 1: LOOP
135.         IF Lo <= Hi THEN
136.             SWAP a(Lo), a(Hi)
137.             Lo = Lo + 1: Hi = Hi - 1
138.         END IF
139.     LOOP UNTIL Lo > Hi
140.     IF Hi > start THEN qSort start, Hi, a()
141.     IF Lo < finish THEN qSort Lo, finish, a()
142. END SUB
143.  
144. SUB thic (x1, y1, x2, y2, thick, K AS _UNSIGNED LONG)
145.     pd2 = _PI(.5)
146.     t2 = thick / 2
147.     IF t2 < 1 THEN t2 = 1
148.     a = _ATAN2(y2 - y1, x2 - x1)
149.     x3 = x1 + t2 * COS(a + pd2)
150.     y3 = y1 + t2 * SIN(a + pd2)
151.     x4 = x1 + t2 * COS(a - pd2)
152.     y4 = y1 + t2 * SIN(a - pd2)
153.     x5 = x2 + t2 * COS(a + pd2)
154.     y5 = y2 + t2 * SIN(a + pd2)
155.     x6 = x2 + t2 * COS(a - pd2)
156.     y6 = y2 + t2 * SIN(a - pd2)
157.     ftri x6, y6, x4, y4, x3, y3, K
158.     ftri x3, y3, x5, y5, x6, y6, K
159. END SUB
160.  
161. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
162.     a& = _NEWIMAGE(1, 1, 32)
163.     _DEST a&
164.     PSET (0, 0), K
165.     _DEST 0
166.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
167.     _FREEIMAGE a& '<<< this is important!
168. END SUB
169.  
170. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
171.     DIM Radius AS INTEGER, RadiusError AS INTEGER
172.     DIM X AS INTEGER, Y AS INTEGER
173.  
174.     Radius = ABS(R)
175.     RadiusError = -Radius
176.     X = Radius
177.     Y = 0
178.  
179.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
180.  
181.     ' Draw the middle span here so we don't draw it twice in the main loop,
182.     ' which would be a problem with blending turned on.
183.     LINE (CX - X, CY)-(CX + X, CY), C, BF
184.  
185.     WHILE X > Y
186.         RadiusError = RadiusError + Y * 2 + 1
187.         IF RadiusError >= 0 THEN
188.             IF X <> Y + 1 THEN
189.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
190.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
191.             END IF
192.             X = X - 1
193.             RadiusError = RadiusError - X * 2
194.         END IF
195.         Y = Y + 1
196.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
197.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
198.     WEND
199. END SUB
200.  
201.  

OK and do some not so random points too, 12 points around circle and center: