Accidental Fractal

[romichess]

I'm not going to say what I was really trying to do, LOL. But what I accidentally ended up with is a fractal! :)

Code: QB64: [Select]

1. DIM ch AS STRING
2.  
3. screenw = _DESKTOPWIDTH
4. screenh = _DESKTOPHEIGHT
5. SCREEN _NEWIMAGE(screenw, screenh, 256)
6. _FULLSCREEN
7.  
8.  
9. repeat = -1
10.  
11. WHILE repeat
12.  
13.     FOR i = 0 TO 32767
14.         FOR j = 0 TO 32767
15.             FOR k = 0 TO 32767
16.                 x = (i OR j OR k) / 32768 * screenw
17.                 y = (i OR k) / 32768 * screenh
18.                 PSET (x, y), 15
19.                 x = screenw - x
20.                 y = screenh - y
21.                 PSET (x, y), 15
22.                 ch = INKEY$
23.                 IF ch = CHR$(27) THEN SYSTEM
24.             NEXT
25.         NEXT
26.     NEXT
27. WEND
28.  
29. SYSTEM
30.  

[romichess]

This one with colors is more interesting.

Code: QB64: [Select]

1. DIM ch AS STRING
2.  
3. screenw = _DESKTOPWIDTH
4. screenh = _DESKTOPHEIGHT
5. SCREEN _NEWIMAGE(screenw, screenh, 256)
6. _FULLSCREEN
7.  
8.  
9. repeat = -1
10.  
11. WHILE repeat
12.  
13.     FOR i = 0 TO 32767
14.         FOR j = 0 TO 32767
15.             FOR k = 0 TO 32767
16.                 x = (i OR j OR k) / 32768 * screenw
17.                 y = (i OR k) / 32768 * screenh
18.                 c = ((i OR j OR k) / 32768 * 6) + 1
19.                 PSET (x, y), c
20.                 x = screenw - x
21.                 y = screenh - y
22.                 c = ((i XOR j XOR k) / 32768 * 6) + 1
23.                 PSET (x, y), c
24.                 ch = INKEY$
25.                 IF ch = CHR$(27) THEN SYSTEM
26.             NEXT
27.         NEXT
28.     NEXT
29. WEND
30.  
31. SYSTEM
32.  
33.  

[romichess]

This is more like what I was trying to do. But, not really exactly like this either.

Code: QB64: [Select]

1. DIM ch AS STRING
2.  
3. screenw = _DESKTOPWIDTH
4. screenh = _DESKTOPHEIGHT
5. SCREEN _NEWIMAGE(screenw, screenh, 256)
6. _FULLSCREEN
7.  
8.  
9. repeat = -1
10.  
11. WHILE repeat
12.  
13.     FOR i = 0 TO 32767
14.         FOR j = 0 TO 32767
15.             c = ((i XOR j) / 32768 * 7) + 1
16.             FOR k = 0 TO 32767
17.                 x = (i XOR j XOR k) / 32768 * screenw
18.                 y = (i XOR k) / 32768 * screenh
19.                 PSET (x, y), c
20.                 x = screenw - x
21.                 y = screenh - y
22.                 PSET (x, y), c
23.                 ch = INKEY$
24.                 IF ch = CHR$(27) THEN SYSTEM
25.             NEXT
26.         NEXT
27.     NEXT
28. WEND
29.  
30. SYSTEM
31.  
32.  

[OldMoses]

I'm always amazed at the things that lie hidden in math and logical operators.

[johnno56]

I am curious as to which version of  QB64 was used to make the fractal? Reason: Version 1.3, on 'my' Linux machine, produces a single multi-coloured diagonal line that begins in the top left of the screen and ends in the bottom right. All I did was 'copy and paste' and F5. If it's just me, then by all means, ignore the ravings of this user and pretend that I didn't post... lol

J

[romichess]

I am curious as to which version of  QB64 was used to make the fractal? Reason: Version 1.3, on 'my' Linux machine, produces a single multi-coloured diagonal line that begins in the top left of the screen and ends in the bottom right. All I did was 'copy and paste' and F5. If it's just me, then by all means, ignore the ravings of this user and pretend that I didn't post... lol

J

I'm using ver 1.3. I checked all three examples, just now. It starts off as a diagonal line, but it builds out from there to fill the screen. It is not very fast. It takes a few minutes to complete. My cpu is an i7-3930k overclocked to 4.2 GHz.

[Richard Frost]

Code: QB64: [Select]

1. _TITLE "More accidental fracals"
2. DEFINT A-Z
3. x1 = 126: y1 = 80: x2 = 302: y2 = 160: z = 220
4. DIM gbuff(12000)
5. SCREEN 12: _SCREENMOVE _MIDDLE
6. DO: _LIMIT 50
7.     a = (a + 3) MOD 360: c = -(a > 180)
8.     y = 120 - 40 * COS(a * ATN(1) / 45)
9.     FOR i = 0 TO 2
10.         j = i * 120: k = i * 4 + c * 2 + 1
11.         c1 = VAL(MID$(" 7 1 8111012", k, 2))
12.         c2 = VAL(MID$(" 612 5 214 9", k, 2))
13.         PSET (x2, y + j), c1
14.         PSET (x2 + z, y + j), c2
15.         GET (x1 + VAL(MID$("122", i + 1, 1)), y1 + j)-(x2, y2 + j), gbuff()
16.         PUT (x1, y1 + j), gbuff()
17.         GET (z + x1 + VAL(MID$("122", i + 1, 1)), y1 + j)-(z + x2 + 1, y2 + j), gbuff()
18.         PUT (z + x1, y1 + j), gbuff()
19.     NEXT i
20. LOOP UNTIL INKEY$ = CHR$(27)

[bplus]

and another accidental find:

Code: QB64: [Select]

1. _TITLE "Sierpinski flies a kite by bplus 2017-10-16"
2. ' after playing with Ashish Kite Fractal
3.  
4. SCREEN _NEWIMAGE(1200, 700, 32)
5. _SCREENMOVE 100, 20
6. WHILE 1
7.     CLS
8.     drawKite 600, 540, 200, a
9.     _DISPLAY
10.     _LIMIT 20
11.     a = a + _PI(2 / 360)
12. WEND
13. SLEEP
14. SUB drawKite (xx, yy, s, a)
15.     x = xx: y = yy
16.     x2 = x + 3 * s * COS(_PI(1 / 2) - a / 2): y2 = y + 3 * s * SIN(_PI(1 / 2) - a / 2)
17.     x3 = x + 3 * s * COS(_PI(1 / 2) + a / 2): y3 = y + 3 * s * SIN(_PI(1 / 2) + a / 2)
18.     SierLineTri x, y, x2, y2, x3, y3, 0
19.     'LINE (x, y)-(x + s * COS(_PI(2) - a / 2), (y - s) + s * SIN(_PI(2) - a / 2))
20.     'LINE (x, y)-(x + s * COS(_PI + a / 2), (y - s) + s * SIN(_PI + a / 2))
21.  
22.     IF s > 10 THEN
23.         drawKite x + 1 * s * COS(_PI(2) - a), (y - s) + 1 * s * SIN(_PI(2) - a), s / 2, a
24.         drawKite x + 1 * s * COS(_PI + a), (y - s) + 1 * s * SIN(_PI + a), s / 2, a
25.     END IF
26. END SUB
27. SUB SierLineTri (x1, y1, x2, y2, x3, y3, depth)
28.     IF depth = 0 THEN 'draw out triangle if level 0
29.         LINE (x1, y1)-(x2, y2)
30.         LINE (x2, y2)-(x3, y3)
31.         LINE (x1, y1)-(x3, y3)
32.     END IF
33.     'find midpoints
34.     IF x2 < x1 THEN mx1 = (x1 - x2) / 2 + x2 ELSE mx1 = (x2 - x1) / 2 + x1
35.     IF y2 < y1 THEN my1 = (y1 - y2) / 2 + y2 ELSE my1 = (y2 - y1) / 2 + y1
36.     IF x3 < x2 THEN mx2 = (x2 - x3) / 2 + x3 ELSE mx2 = (x3 - x2) / 2 + x2
37.     IF y3 < y2 THEN my2 = (y2 - y3) / 2 + y3 ELSE my2 = (y3 - y2) / 2 + y2
38.     IF x3 < x1 THEN mx3 = (x1 - x3) / 2 + x3 ELSE mx3 = (x3 - x1) / 2 + x1
39.     IF y3 < y1 THEN my3 = (y1 - y3) / 2 + y3 ELSE my3 = (y3 - y1) / 2 + y1
40.  
41.     LINE (mx1, my1)-(mx2, my2) '  'draw all inner triangles
42.     LINE (mx2, my2)-(mx3, my3)
43.     LINE (mx1, my1)-(mx3, my3)
44.  
45.     IF depth < 4 THEN 'not done so call me again
46.         SierLineTri x1, y1, mx1, my1, mx3, my3, depth + 1
47.         SierLineTri x2, y2, mx1, my1, mx2, my2, depth + 1
48.         SierLineTri x3, y3, mx3, my3, mx2, my2, depth + 1
49.     END IF
50. END SUB
51.  
52.  

[romichess]

Guy's were they really accidental? What were you trying to have revolve or fly? I was just trying to cover every pixel of the screen in an unusual pattern as the third example does.

[bplus]

Guy's were they really accidental? What were you trying to have revolve or fly? I was just trying to cover every pixel of the screen in an unusual pattern as the third example does.

In my case, I just was experimenting replacing a triangle with a Sierpinski in Ashish Kite Fractal. I had no idea it would dance around like it did. Of course I beefed up the numbers to see it dance better once I saw that there was a show to be seen. :)

[bplus]

Code: QB64: [Select]

1. _TITLE "Birth of Sierpinski Flies a Kite" 'b+ 2020-01-02
2. SCREEN _NEWIMAGE(800, 600, 32)
3. _SCREENMOVE 300, 50
4. drawKite 400, 500, 140, .5 'here was Ashish fractal, now put a 2 after drawKite
5. PRINT "Original Kite Fractal from Ashish, press any..."
6. SLEEP
7. drawKite2 400, 500, 140, .5
8. PRINT "Sub in Sierpinski, press any..."
9. SLEEP
10. CLS
11. drawKite2 400, 500, 140, -.5
12. PRINT "Mess with the a variable, press any..."
13. SLEEP
14. FOR i = -1 TO 1 STEP .1
15.     CLS
16.     drawKite2 400, 500, 140, i
17.     PRINT "Run a continuous change on variable a, press any..."
18.     _LIMIT 15
19. NEXT
20. SLEEP
21. FOR i = _PI(-2) TO _PI(2) STEP .1
22.     CLS
23.     drawKite2 400, 500, 140, i
24.     PRINT "Oh more continuous change on variable a, press any..."
25.     _LIMIT 15
26. NEXT
27. SLEEP
28. CLS
29. PRINT "WOW! what was that!?"
30. PRINT
31. _DELAY 1
32. PRINT "The Birth of Sierpinski Flies a Kite."
33. PRINT
34. _DELAY 1
35. PRINT "Actually any symmetric object might dance around like that!"
36. PRINT
37. _DELAY 1
38. PRINT "Maybe you have one to try?"
39.  
40. SUB drawKite (x, y, s, a)
41.     LINE (x, y)-(x + s * COS(_PI(2) - a), (y - s) + s * SIN(_PI(2) - a))
42.     LINE (x, y)-(x + s * COS(_PI + a), (y - s) + s * SIN(_PI + a))
43.     IF s > 1 THEN
44.         drawKite x + s * COS(_PI(2) - a), (y - s) + s * SIN(_PI(2) - a), s / 2, a
45.         drawKite x + s * COS(_PI + a), (y - s) + s * SIN(_PI + a), s / 2, a
46.     END IF
47. END SUB
48.  
49. SUB drawKite2 (xx, yy, s, a)
50.     x = xx: y = yy
51.     x2 = x + 3 * s * COS(_PI(1 / 2) - a / 2): y2 = y + 3 * s * SIN(_PI(1 / 2) - a / 2)
52.     x3 = x + 3 * s * COS(_PI(1 / 2) + a / 2): y3 = y + 3 * s * SIN(_PI(1 / 2) + a / 2)
53.     SierLineTri x, y, x2, y2, x3, y3, 0
54.     IF s > 10 THEN
55.         drawKite2 x + 1 * s * COS(_PI(2) - a), (y - s) + 1 * s * SIN(_PI(2) - a), s / 2, a
56.         drawKite2 x + 1 * s * COS(_PI + a), (y - s) + 1 * s * SIN(_PI + a), s / 2, a
57.     END IF
58. END SUB
59.  
60.  
61. SUB SierLineTri (x1, y1, x2, y2, x3, y3, depth)
62.     IF depth = 0 THEN 'draw out triangle if level 0
63.         LINE (x1, y1)-(x2, y2)
64.         LINE (x2, y2)-(x3, y3)
65.         LINE (x1, y1)-(x3, y3)
66.     END IF
67.     'find midpoints
68.     IF x2 < x1 THEN mx1 = (x1 - x2) / 2 + x2 ELSE mx1 = (x2 - x1) / 2 + x1
69.     IF y2 < y1 THEN my1 = (y1 - y2) / 2 + y2 ELSE my1 = (y2 - y1) / 2 + y1
70.     IF x3 < x2 THEN mx2 = (x2 - x3) / 2 + x3 ELSE mx2 = (x3 - x2) / 2 + x2
71.     IF y3 < y2 THEN my2 = (y2 - y3) / 2 + y3 ELSE my2 = (y3 - y2) / 2 + y2
72.     IF x3 < x1 THEN mx3 = (x1 - x3) / 2 + x3 ELSE mx3 = (x3 - x1) / 2 + x1
73.     IF y3 < y1 THEN my3 = (y1 - y3) / 2 + y3 ELSE my3 = (y3 - y1) / 2 + y1
74.     LINE (mx1, my1)-(mx2, my2) '  'draw all inner triangles
75.     LINE (mx2, my2)-(mx3, my3)
76.     LINE (mx1, my1)-(mx3, my3)
77.     IF depth < 4 THEN 'not done so call me again
78.         SierLineTri x1, y1, mx1, my1, mx3, my3, depth + 1
79.         SierLineTri x2, y2, mx1, my1, mx2, my2, depth + 1
80.         SierLineTri x3, y3, mx3, my3, mx2, my2, depth + 1
81.     END IF
82. END SUB
83.  
84.