« previous next »
Pages: [1]   Go Down

Author Topic: Accidental Fractal  (Read 5110 times)

0 Members and 1 Guest are viewing this topic.

Offline romichess

  • Forum Regular
  • Posts: 145
    • View Profile
Accidental Fractal
« on: January 01, 2020, 04:57:13 am »
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]
  2.  
  3. screenw = _DESKTOPWIDTH
  4. screenh = _DESKTOPHEIGHT
  5. SCREEN _NEWIMAGE(screenw, screenh, 256)
  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
  28.  
  30.  
Logged
My name is Michael, but you can call me Mike :)

Offline romichess

  • Forum Regular
  • Posts: 145
    • View Profile
Re: Accidental Fractal
« Reply #1 on: January 01, 2020, 05:35:01 am »
This one with colors is more interesting.

Code: QB64: [Select]
  2.  
  3. screenw = _DESKTOPWIDTH
  4. screenh = _DESKTOPHEIGHT
  5. SCREEN _NEWIMAGE(screenw, screenh, 256)
  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
  30.  
  32.  
  33.  
Logged
My name is Michael, but you can call me Mike :)

Offline romichess

  • Forum Regular
  • Posts: 145
    • View Profile
Re: Accidental Fractal
« Reply #2 on: January 01, 2020, 05:57:29 am »
This is more like what I was trying to do. But, not really exactly like this either.
Code: QB64: [Select]
  2.  
  3. screenw = _DESKTOPWIDTH
  4. screenh = _DESKTOPHEIGHT
  5. SCREEN _NEWIMAGE(screenw, screenh, 256)
  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
  29.  
  31.  
  32.  
Logged
My name is Michael, but you can call me Mike :)

Offline OldMoses

  • Seasoned Forum Regular
  • Posts: 469
    • View Profile
Re: Accidental Fractal
« Reply #3 on: January 02, 2020, 05:36:52 am »
I'm always amazed at the things that lie hidden in math and logical operators.
Logged

Offline johnno56

  • Forum Resident
  • Posts: 1270
  • Live long and prosper.
    • View Profile
Re: Accidental Fractal
« Reply #4 on: January 02, 2020, 06:03:56 am »
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
Logged
Logic is the beginning of wisdom.

Offline romichess

  • Forum Regular
  • Posts: 145
    • View Profile
Re: Accidental Fractal
« Reply #5 on: January 02, 2020, 12:22:34 pm »
Quote from: johnno56 on January 02, 2020, 06:03:56 am
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.
Logged
My name is Michael, but you can call me Mike :)

Offline Richard Frost

  • Seasoned Forum Regular
  • Posts: 316
  • Needle nardle noo. - Peter Sellers
    • View Profile
Re: Accidental Fractal
« Reply #6 on: January 02, 2020, 04:16:08 pm »
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)
  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
Logged
It works better if you plug it in.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Accidental Fractal
« Reply #7 on: January 02, 2020, 04:56:02 pm »
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
  7.     CLS
  8.     drawKite 600, 540, 200, a
  9.     _DISPLAY
  10.     _LIMIT 20
  11.     a = a + _PI(2 / 360)
  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
  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
  51.  
  52.  
Logged

Offline romichess

  • Forum Regular
  • Posts: 145
    • View Profile
Re: Accidental Fractal
« Reply #8 on: January 02, 2020, 05:17:30 pm »
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.
Logged
My name is Michael, but you can call me Mike :)

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Accidental Fractal
« Reply #9 on: January 02, 2020, 07:19:25 pm »
Quote from: romichess on January 02, 2020, 05:17:30 pm
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. :)
Logged

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Accidental Fractal
« Reply #10 on: January 02, 2020, 10:11:30 pm »
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..."
  7. drawKite2 400, 500, 140, .5
  8. PRINT "Sub in Sierpinski, press any..."
  11. drawKite2 400, 500, 140, -.5
  12. PRINT "Mess with the a variable, press any..."
  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
  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
  29. PRINT "WOW! what was that!?"
  32. PRINT "The Birth of Sierpinski Flies a Kite."
  35. PRINT "Actually any symmetric object might dance around like that!"
  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
  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
  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
  83.  
  84.  
Logged
Pages: [1]   Go Up
« previous next »