Fractals
Apr 25, 2012 3:33:16 GMT 1
Post by Deleted on Apr 25, 2012 3:33:16 GMT 1
Fractals are the reason why I started to program again after a very long break. I just love them. This program draws Sierpinski Triangle and Mandelbrot Set. It's possible to choose two color schemes for Mandelbrot Set and magnify it up to x312500000.
INCLUDE "/usr/lib/bacon/hug.bac"
HUGOPTIONS ("CANVAS GL")
HUGOPTIONS ("GL_FREEZE 1")
GLOBAL X, Y, C, POWI, K, LOS, STAN
GLOBAL PRZESX, PRZESY, PRZELX, PRZELY, A, B, X2, Y2, X3, Y3, X4, Y4, A2, B2, Z, MYSZX, MYSZY TYPE FLOATING
GLOBAL KOL$, CZER$, ZIEL$, NIEB$
'set variable values for mandelbrot set
POWI = 1
PRZESX = 0.0
PRZESY = 0.0
PRZELX = 3.0 / (640.0 * POWI)
PRZELY = 2.0 / (480.0 * POWI)
'draw sierpinski triangle
FUNCTION RYSUJ_SIERPINSKI
DISABLE (MANDELBROT)
DISABLE (SIERPINSKI)
DRAW (RYSUNEK)
SQUARE ("#000000", 0, 0, 640, 480, TRUE)
X3 = 320.0
Y4 = 320.0
Y3 = 0.0
Y4 = 0.0
FOR K = 1 TO 100000
LOS = RANDOM (3)
IF LOS = 0 THEN
X3 = (X4 + 320.0) / 2.0
Y3 = Y4 / 2.0
ELIF LOS = 1 THEN
X3 = X4 / 2.0
Y3 = (Y4 + 480.0) / 2.0
ELSE
X3 = (X4 + 640.0) / 2.0
Y3 = (Y4 + 480.0) / 2.0
END IF
'set colors for pixels
IF ROUND (Y3 / 1.88) < 16 THEN
CZER$ = CONCAT$ ("0", HEX$ (ROUND (Y3 / 1.88)))
ELSE
CZER$ = HEX$ (ROUND (Y3 / 1.88))
END IF
IF ROUND (X3 / 2.5) < 16 THEN
ZIEL$ = CONCAT$ ("0", HEX$ (ROUND (X3 / 2.5)))
ELSE
ZIEL$ = HEX$ (ROUND (X3 / 2.5))
END IF
IF ROUND (255 - (Y3 / 1.88)) < 16 THEN
NIEB$ = CONCAT$ ("0", HEX$ (ROUND (255 - (Y3 / 1.88))))
ELSE
NIEB$ = HEX$ (ROUND (255 - (Y3 / 1.88)))
END IF
KOL$ = CONCAT$ ("#", CZER$, ZIEL$, NIEB$)
'draw pixel with definied color
PIXEL (KOL$, ROUND (X3), ROUND (Y3))
X4 = X3
Y4 = Y3
IF MOD (K, 20) = 0 THEN
SYNC ()
END IF
NEXT
ENABLE (MANDELBROT)
ENABLE (SIERPINSKI)
RETURN (FALSE)
END FUNCTION
'draw mandelbrot set
FUNCTION RYSUJ_MANDELBROT
DISABLE (MANDELBROT)
DISABLE (SIERPINSKI)
DRAW(RYSUNEK)
SQUARE ("#FFFFFF", 0, 0, 640, 480, TRUE)
'main calculation loop
FOR X = 0 TO 639
FOR Y = 0 TO 479
A = 0.0
B = 0.0
C = 0.0
Z = 0.0
X2 = (PRZELX * (X + (PRZESX * POWI))) - 2.0
Y2 = (PRZELY * (Y + (PRZESY * POWI))) - 1.0
WHILE (C < 255) DO
A2 = A * A - B * B
B2 = 2 * A * B
A = A2 + X2
B = B2 + Y2
Z = A * A + B * B
IF Z >= 4.0 THEN
BREAK
END IF
C = C + 1
WEND
'set colors for pixels
IF C = 255 THEN
IF STAN = 0 THEN
PIXEL ("#000000", X, Y)
ELSE
PIXEL ("#FFFFFF", X, Y)
END IF
ELSE
IF STAN = 0 THEN
IF 255 - C < 16 THEN
CZER$ = CONCAT$ ("0", HEX$ (255 - C))
ELSE
CZER$ = HEX$ (255 - C)
END IF
IF MOD (C, 50) * 5 < 16 THEN
ZIEL$ = CONCAT$ ("0", HEX$ (MOD (C, 50) * 5))
ELSE
ZIEL$ = HEX$ (MOD (C, 50) * 5)
END IF
IF C < 16 THEN
NIEB$ = CONCAT$ ("0", HEX$ (C))
ELSE
NIEB$ = HEX$ (C)
END IF
ELSE
IF C = 255 THEN
CZER$ = CONCAT$ (HEX$ (C))
ZIEL$ = CONCAT$ (HEX$ (C))
NIEB$ = CONCAT$ (HEX$ (C))
ELIF C / 1.1 < 16 THEN
CZER$ = CONCAT$ ("0", HEX$ (C / 1.1))
ZIEL$ = CONCAT$ ("0", HEX$ (C / 1.1))
NIEB$ = CONCAT$ ("0", HEX$ (C / 1.1))
ELSE
CZER$ = CONCAT$ (HEX$ (C / 1.1))
ZIEL$ = CONCAT$ (HEX$ (C / 1.1))
NIEB$ = CONCAT$ (HEX$ (C / 1.1))
END IF
END IF
KOL$=CONCAT$ ("#", CZER$, ZIEL$, NIEB$)
'draw pixel with definied color
PIXEL (KOL$, X, Y)
END IF
NEXT
SYNC ()
NEXT
ENABLE (MANDELBROT)
ENABLE (SIERPINSKI)
RETURN (FALSE)
END FUNCTION
'set action after draw button was clicked
SUB AKTYWUJ
IF GET (SIERPINSKI) THEN
TIMEOUT (50, RYSUJ_SIERPINSKI)
END IF
IF GET (MANDELBROT) THEN
POWI = 1
PRZESX = 0.0
PRZESY = 0.0
PRZELX = 3.0 / (640.0 * POWI)
PRZELY = 2.0 / (480.0 * POWI)
TEXT (POZYCJAX, "X: -2")
TEXT (POZYCJAY, "Y: 1")
TEXT (ZOOM, "Zoom: x 1")
IF GET (KOLOR) THEN
STAN = 0
TIMEOUT (50, RYSUJ_MANDELBROT)
ELSE
STAN = 1
TIMEOUT (50, RYSUJ_MANDELBROT)
ENDIF
END IF
END SUB
'shows additional options for mandelbrot set
SUB POKAZ
SHOW (KOLOR)
SHOW (KOLOR2)
SHOW (ZOOM)
SHOW (POZYCJAX)
SHOW (POZYCJAY)
END SUB
'hide additional options for mandelbrot set
SUB SCHOWAJ
HIDE (KOLOR)
HIDE (KOLOR2)
HIDE (ZOOM)
HIDE (POZYCJAX)
HIDE (POZYCJAY)
END SUB
'calculate zoom and new position for mandelbrot function, put information about zoom and position on the screen
SUB POWIEKSZENIE
IF GET (MANDELBROT) THEN
IF POWI < POW (50, 5) THEN
MYSZX = MOUSE (0)
MYSZY = MOUSE (1)
PRZESX = PRZESX + MYSZX / POWI
PRZESY = PRZESY + MYSZY / POWI
POWI = POWI * 50
PRZELX = 3.0 / (640.0 * POWI)
PRZELY = 2.0 / (480.0 * POWI)
TEXT (POZYCJAX, CONCAT$ ("X: ", STR$ ((PRZELX * (MYSZX + (PRZESX * POWI)) - 2.0))))
TEXT (POZYCJAY, CONCAT$ ("Y: ", STR$ ((-(PRZELY * (MYSZY + (PRZESY * POWI)) - 1.0)))))
ELSE
POWI = 1
PRZELX = 3.0 / (640.0 * POWI)
PRZELY = 2.0 / (480.0 * POWI)
PRZESX = 0.0
PRZESY = 0.0
TEXT (POZYCJAX, "X: -2")
TEXT (POZYCJAY, "Y: 1")
END IF
IF POWI = 312500000 THEN
TEXT (ZOOM, CONCAT$ ("Zoom: x ", STR$ (POWI), " (maximum zoom)"))
ELSE
TEXT (ZOOM, CONCAT$ ("Zoom: x ", STR$ (POWI)))
END IF
IF GET (KOLOR) THEN
STAN = 0
TIMEOUT (50, RYSUJ_MANDELBROT)
ELSE
STAN = 1
TIMEOUT (50, RYSUJ_MANDELBROT)
END IF
END IF
END SUB
'quit program
SUB ZAKONCZ
QUIT
END SUB
'create GUI
WIN = WINDOW ("Fractals", 660, 600)
RYSUNEK = CANVAS (640, 480)
RYSUJ = BUTTON ("Draw", 100, 30)
KONIEC = BUTTON ("Quit", 100, 30)
SIERPINSKI = RADIO ("Sierpinski Triangle", 150, 20, 0)
MANDELBROT = RADIO ("Mandelbrot Set", 150, 20, SIERPINSKI)
KOLOR = RADIO ("Color", 150, 20, 0)
KOLOR2 = RADIO ("Greyscale", 150, 20, KOLOR)
LINIA = VSEPARATOR (45)
ZOOM = ENTRY ("Zoom: x 1", 290, 20)
POZYCJAX = ENTRY ("X: -2", 140, 20)
POZYCJAY = ENTRY ("Y: 1", 140, 20)
CALLBACK (RYSUJ, AKTYWUJ)
CALLBACK (KONIEC, ZAKONCZ)
CALLBACK (MANDELBROT, POKAZ)
CALLBACK (SIERPINSKI, SCHOWAJ)
CALLBACK (RYSUNEK, POWIEKSZENIE)
ATTACH (WIN, RYSUNEK, 10, 10)
ATTACH (WIN, SIERPINSKI, 10, 500)
ATTACH (WIN, MANDELBROT, 10, 525)
ATTACH (WIN, LINIA, 175, 500)
ATTACH (WIN, KOLOR, 200, 500)
ATTACH (WIN, KOLOR2, 200, 525)
ATTACH (WIN, RYSUJ, 10, 560)
ATTACH (WIN, KONIEC, 550, 560)
ATTACH (WIN, ZOOM, 360, 500)
ATTACH (WIN, POZYCJAX, 360, 525)
ATTACH (WIN, POZYCJAY, 510, 525)
HIDE (KOLOR)
HIDE (KOLOR2)
HIDE (ZOOM)
DISABLE (ZOOM)
DISABLE (POZYCJAX)
DISABLE (POZYCJAY)
HIDE (POZYCJAX)
HIDE (POZYCJAY)
DISPLAY