Obligatory fractal

havard

Havard
Staff member
Admin
Hoppy Gorilla
MANDY18.pngMANDY19.png
Code:
#COMPILE EXE
#DIM ALL
#CONSOLE ON

REM for PowerBASIC Console Compiler, or kill off the console directive and
REM that print statement lower down, and it should Just Work[tm]
FUNCTION PBMAIN () AS LONG

    DIM X AS LONG
    DIM Y AS LONG
    DIM Rx AS DOUBLE
    DIM ry AS DOUBLE

        DIM hWin AS LONG
    DIM I AS LONG

    DIM FAWNT AS LONG

    DIM Dumb AS STRING

    DIM z AS DOUBLE

    FONT NEW "PragmataPro", 32, 0 TO FAWNT

    GRAPHIC WINDOW "", -1, -1, 1920, 1080 TO hWin
        GRAPHIC COLOR RGB(192,192,192), %BLACK
        GRAPHIC CLEAR
    GRAPHIC ATTACH hWin, 0

    GRAPHIC SET FONT FAWNT

    DIM colour AS LONG



    FOR Y = 0 TO 1080
        FOR X = 0 TO 1920
            REM x -2.0,0.47 y -1.12,1.12
            rx = SCALE(x, 1920, -1.25,-1.23)
            ry = SCALE(y, 1080, -0.125,-0.112)

            colour = colorizer(mand(rx,ry,1024))

            GRAPHIC SET PIXEL (x,y), colour

        NEXT
        PRINT "LINE",y,rx,ry,colour
    NEXT
    GRAPHIC SAVE "MANDY.BMP"
END FUNCTION

FUNCTION SCALE (n AS LONG, mv AS LONG, low AS DOUBLE, high AS DOUBLE) AS DOUBLE
    DIM rng AS DOUBLE
    DIM div AS DOUBLE

    rng = high - low

    div = rng / mv

    SCALE = n * div + low
END FUNCTION

FUNCTION mand (x0 AS DOUBLE, y0 AS DOUBLE, max_iter AS LONG) AS LONG

    DIM i AS LONG
    DIM x AS DOUBLE
    DIM y AS DOUBLE

    i = 0
    x = 0
    y = 0
    WHILE (x*x + y*y <= 2*2 AND i < max_iter)
        DIM tmp AS DOUBLE
        tmp = x*x - y*y + x0
        y = 2*x*y + y0
        x = tmp
        i = i + 1
    WEND

    mand = i

END FUNCTION


FUNCTION colorizer (ival AS LONG) AS LONG
    REM max ival is 1024

    DIM RED AS LONG
    DIM BLUE AS LONG
    DIM GREEN AS LONG

    IF IVAL = 1024 THEN
        COLORIZER = 0
    ELSE
        BLUE  = ival AND &H00000007
        GREEN = ival AND &H00000038
        RED   = ival AND &H000001c0


        ROTATE RIGHT GREEN, 3
        ROTATE RIGHT RED, 6

        colorizer = RGB(red*16, green*16, blue*16)
    END IF
END FUNCTION
 

havard

Havard
Staff member
Admin
Hoppy Gorilla
Code:
#COMPILE EXE
#DIM ALL
#CONSOLE ON



%ITERATIONS = 4096

REM This may eventually do the mandelbrot, but having fun with this as it is.

FUNCTION PBMAIN () AS LONG

    DIM X AS LONG
    DIM Y AS LONG
    DIM Rx AS DOUBLE
    DIM ry AS DOUBLE

        DIM hWin AS LONG
    DIM I AS LONG

    DIM FAWNT AS LONG


    DIM z AS DOUBLE

    FONT NEW "PragmataPro", 32, 0 TO FAWNT

    GRAPHIC WINDOW "", -1, -1, 1920, 1080 TO hWin
        GRAPHIC COLOR RGB(192,192,192), %BLACK
        GRAPHIC CLEAR
    GRAPHIC ATTACH hWin, 0

    GRAPHIC SET FONT FAWNT

    DIM colour AS LONG

    DIM dumb AS LONG
    DIM MOOP AS LONG
    DIM steppo AS LONG

    steppo = 16



    FOR dumb = 0 TO steppo*2
      FOR X = 0+dumb TO 1920 STEP steppo*2
          FOR moop = 0 TO steppo
            FOR Y = 0+moop TO 1080 STEP steppo
                REM x -2.0,0.47 y -1.12,1.12
                rx = SCALE(x, 1920, 0.02025,0.023125)
                ry = SCALE(y, 1080, 0.6325,0.635)

                colour = colorizer(mand(rx,ry,%ITERATIONS))

                GRAPHIC SET PIXEL (x,y), colour
             NEXT
            NEXT

        NEXT
        PRINT "LINE",y,rx,ry,colour
    NEXT
    GRAPHIC SAVE "MANDY.BMP"
END FUNCTION

FUNCTION SCALE (n AS LONG, mv AS LONG, low AS DOUBLE, high AS DOUBLE) AS DOUBLE
    DIM rng AS DOUBLE
    DIM div AS DOUBLE

    rng = high - low

    div = rng / mv

    SCALE = n * div + low
END FUNCTION

FUNCTION mand (x0 AS DOUBLE, y0 AS DOUBLE, max_iter AS LONG) AS LONG

    DIM i AS LONG
    DIM x AS DOUBLE
    DIM y AS DOUBLE

    i = 0
    x = 0
    y = 0
    WHILE (x*x + y*y <= 2*2 AND i < max_iter)
        DIM tmp AS DOUBLE
        tmp = x*x - y*y + x0
        y = 2*x*y + y0
        x = tmp
        i = i + 1
    WEND

    mand = i

END FUNCTION


FUNCTION colorizer (ival AS LONG) AS LONG
    REM max ival is 4096

    DIM RED AS LONG
    DIM BLUE AS LONG
    DIM GREEN AS LONG

    IF IVAL = %ITERATIONS THEN
        COLORIZER = 0
    ELSE
        BLUE  = ival AND &H0000000f
        GREEN = ival AND &H000000f0
        RED   = ival AND &H00000f00


        ROTATE RIGHT GREEN, 4
        ROTATE RIGHT RED,   8

        ROTATE LEFT BLUE, 4
        ROTATE LEFT GREEN, 4
        ROTATE LEFT RED, 4

        REM print RED,GREEN,BLUE
        colorizer = RGB(red, green, blue) AND &h00FFFFFF
    END IF
END FUNCTION

Posting the code for this one final fractal for the night so I don't lose it. I really should have kept this whole thing under revision control, because I completely lost some of the variants that produced the earlier images. It's not so much the math part of it... that will always work out and the approximate locations are easy enough to guess. No, it's the iterations-to-color thing that gives so much of the magic.
 

Attachments

  • MANDY26.png
    MANDY26.png
    2 MB · Views: 1

havard

Havard
Staff member
Admin
Hoppy Gorilla
Most recent version has a few new features.
  • after it finishes its run you can click two points and it will zoom in
  • better colors once I realized I needed to have the number of iterations significantly larger than the color palette rather than an exact match to avoid mud at the top end
  • ability to make the horizontal loop skip some number of items using number keys on keypad
  • Q to quit
  • ESC to stop rendering run
Code:
#COMPILE EXE
#DIM ALL

%ITERATIONS = 32768

GLOBAL steppo AS LONG

FUNCTION PBMAIN () AS LONG


    DIM C1X AS LONG
    DIM C1Y AS LONG
    DIM C2X AS LONG
    DIM C2Y AS LONG

    DIM hWin AS LONG
    DIM I AS LONG

    DIM FAWNT AS LONG


    DIM z AS DOUBLE

    FONT NEW "PragmataPro", 32, 0 TO FAWNT

    GRAPHIC WINDOW "", -1, -1, 1920, 1080 TO hWin
    GRAPHIC COLOR RGB(192,192,192), %BLACK
    GRAPHIC CLEAR
    GRAPHIC ATTACH hWin, 0

    GRAPHIC SET FONT FAWNT

    DIM newx1 AS DOUBLE
    DIM newx2 AS DOUBLE
    DIM newy1 AS DOUBLE
    DIM newy2 AS DOUBLE

    newx1 = -2.00
    newx2 =  2.00
    newy1 = -1.12
    newy2 =  1.12

    STEPPO = 1

    DO
        GRAPHIC CLEAR
        DRAWIT newx1,newx2,newy1,newy2
        DIM CLICKY AS LONG

        CLICKY = 0

        WHILE (CLICKY=0)
            GRAPHIC WINDOW CLICK TO CLICKY,c1x,c1y
        WEND

        CLICKY = 0

        WHILE (CLICKY=0)
            GRAPHIC WINDOW CLICK TO CLICKY,c2x,c2y
        WEND

        GRAPHIC BOX (c1x,c1y) - (c2x,c2y), 0, %RED, %RED, 3

        DIM tx1 AS DOUBLE
        DIM tx2 AS DOUBLE
        DIM ty1 AS DOUBLE
        DIM ty2 AS DOUBLE

        tx1 = newx1
        tx2 = newx2
        ty1 = newy1
        ty2 = newy2

        newx1 = SCALE(c1x, 1920, tx1,tx2)
        newx2 = SCALE(c2x, 1920, tx1,tx2)
        newy1 = SCALE(c1y, 1080, ty1,ty2)
        newy2 = SCALE(c2y, 1080, ty1,ty2)

        GRAPHIC SAVE "MANDYCLICK.BMP"
    LOOP

END FUNCTION

FUNCTION DRAWIT (x1 AS DOUBLE, x2 AS DOUBLE, y1 AS DOUBLE, y2 AS DOUBLE) AS LONG
    DIM colour AS LONG
    DIM X AS LONG
    DIM Y AS LONG
    DIM Rx AS DOUBLE
    DIM ry AS DOUBLE

    DIM dumb AS LONG
    DIM MOOP AS LONG


    DIM kk AS STRING

    FOR Y = 0 TO 1080
        FOR X = 0 TO 1920 STEP steppo
                REM x -2.0,0.47 y -1.12,1.12
                REM x 0.02025,0.023125, y 0.6325,0.635 is neat
                rx = SCALE(x, 1920, x1,x2)
                ry = SCALE(y, 1080, y1,y2)

                colour = colorizer(mand(rx,ry,%ITERATIONS))

                GRAPHIC SET PIXEL (x,y), colour

                GRAPHIC INKEY$ TO kk

                IF kk = $ESC THEN
                    GOTO byeman
                ELSEIF (ASC(kk) > 48 AND ASC(kk) < 58) THEN
                    steppo = (ASC(kk)-48)
                ELSEIF ASC(kk) = 48 THEN
                    steppo = 16
                ELSEIF kk = "Q" THEN
                    TANKME
                ELSEIF kk = "q" THEN
                    tankme
                END IF
             NEXT
        NEXT
        REM PRINT "LINE",y,rx,ry,colour
    BYEMAN:

    GRAPHIC SAVE "MANDY.BMP"


END FUNCTION


FUNCTION SCALE (n AS LONG, mv AS LONG, low AS DOUBLE, high AS DOUBLE) AS DOUBLE
    DIM rng AS DOUBLE
    DIM div AS DOUBLE

    rng = high - low

    div = rng / mv

    SCALE = n * div + low
END FUNCTION

FUNCTION mand (x0 AS DOUBLE, y0 AS DOUBLE, max_iter AS LONG) AS LONG

    DIM i AS LONG
    DIM x AS DOUBLE
    DIM y AS DOUBLE

    i = 0
    x = 0
    y = 0
    WHILE (x*x + y*y <= 2*2 AND i < max_iter)
        DIM tmp AS DOUBLE
        tmp = x*x - y*y + x0
        y = 2*x*y + y0
        x = tmp
        i = i + 1
    WEND

    mand = i

END FUNCTION


FUNCTION colorizer (ival AS LONG) AS LONG
    REM max ival is 4096

    DIM RED AS LONG
    DIM BLUE AS LONG
    DIM GREEN AS LONG

    IF IVAL = %ITERATIONS THEN
        COLORIZER = 0
    ELSE
        BLUE  = ival AND &H0000000f
        GREEN = ival AND &H000000f0
        RED   = ival AND &H00000f00


        ROTATE RIGHT GREEN, 4
        ROTATE RIGHT RED,   8

        ROTATE LEFT BLUE, 4
        ROTATE LEFT GREEN, 4
        ROTATE LEFT RED, 4

        REM print RED,GREEN,BLUE
        colorizer = RGB(red, green, blue) AND &h00FFFFFF
    END IF
END FUNCTION

FUNCTION TANKME AS LONG
    GRAPHIC SAVE "MANDY_.BMP"
    END
END FUNCTION

MANDY35.png
 

havard

Havard
Staff member
Admin
Hoppy Gorilla
Taking a step back to Just Drawing The Fractal... I wanted to speed things up a bit. So, I verified that creating the image would be about as slow if I pulled out the fractal part, and sure enough, it was.

As a brief overview, when you draw something in a GUI, you generally aren't writing directly to a framebuffer. Rather, you are sending a request to update a part of the screen, so there's potentially a very large amount of code invoked to update one single pixel. You then have to wait for the system to copy its back buffer to the live screen. Only then can you step from pixel 1183,17 to 1184,17. What's the solution? Use our own back buffer and only copy it to the screen when we want to. Fortunately, PowerBASIC provides a bitmap buffer for just this sort of occasion. Going back to the original, non-zooming version of our code, we now have something like this:

Code:
#COMPILE EXE
#DIM ALL
#CONSOLE ON



%ITERATIONS = 4096

REM This may eventually do the mandelbrot, but having fun with this as it is.

FUNCTION PBMAIN () AS LONG

    DIM X AS LONG
    DIM Y AS LONG
    DIM Rx AS EXT
    DIM ry AS EXT

        DIM hWin AS LONG
    DIM I AS LONG

    DIM FAWNT AS LONG


    DIM z AS EXT

    FONT NEW "PragmataPro", 32, 0 TO FAWNT

    GRAPHIC WINDOW "", -1, -1, 1920, 1080 TO hWin
        GRAPHIC COLOR RGB(192,192,192), %BLACK
        GRAPHIC CLEAR
    GRAPHIC ATTACH hWin, 0

    GRAPHIC SET FONT FAWNT

    DIM colour AS LONG

    DIM dumb AS LONG
    DIM MOOP AS LONG
    DIM steppo AS LONG

    steppo = 16


    REM blocky
    'for MOOP = 8192 TO 8192 STEP 128
    'for x = 0 to 1920 step steppo
    '    for y = 0 to 1080 step steppo
    '          rx = SCALE(x, 1920, 0.02025,0.023125)
    '          ry = SCALE(y, 1080, 0.6325,0.635)
    '
    '          colour = colorizer(mand(rx,ry,MOOP))
    '
    '          GRAPHIC BOX (x,y) - (x+steppo,y+steppo), 0, colour, colour
    '    next
    'next
    'print "MOOP",moop
    'next

    'for steppo = 0 to 8192 step 128

    DIM maniac AS QUAD
    DIM loopy AS QUAD
    DIM manmax AS QUAD
    DIM manavg AS QUAD

    'DIM screenar(1920,1080) as long
    DIM gBmp AS LONG
    GRAPHIC BITMAP NEW 1920, 1080 TO gBmp
    GRAPHIC ATTACH gBmp,0

    steppo = 0

    FOR steppo = 0 TO 16
    FOR y = 0+steppo TO 1080 STEP 16
        TIX loopy
        FOR x = 0 TO 1920
              rx = SCALE(x, 1920, 0.02025,0.023125)
              ry = SCALE(y, 1080, 0.6325,0.635)
            TIX maniac
            colour = colorizer(mand(rx,ry,%ITERATIONS))
            'colour = %BLUE
            GRAPHIC SET PIXEL (x,y), colour

            TIX END maniac
        NEXT
        manmax = MAX(maniac,manmax)
        manavg = (manavg+maniac)/2
        'print "LINE",y,rx,ry,colour
        TIX END loopy

        PRINT "LINE",loopy,maniac,manmax,loopy-manmax,manavg
    NEXT
        GRAPHIC ATTACH hwin,0
        GRAPHIC COPY gbmp,0
        GRAPHIC ATTACH gbmp,0

    NEXT

    GRAPHIC ATTACH hWin,0
    GRAPHIC COPY gBmp,0
    GRAPHIC SAVE "MANDY.BMP"
END FUNCTION

FUNCTION SCALE (n AS LONG, mv AS LONG, low AS EXT, high AS EXT) AS EXT
    DIM rng AS EXT
    DIM div AS EXT

    rng = high - low

    div = rng / mv

    SCALE = n * div + low
END FUNCTION

FUNCTION mand (x0 AS EXT, y0 AS EXT, max_iter AS LONG) AS LONG

    REGISTER i AS LONG
    REGISTER x AS EXT
    REGISTER y AS EXT

    i = 0
    x = 0
    y = 0
    WHILE (x*x + y*y <= 4 AND i < max_iter)
        DIM tmp AS EXT
        tmp = x*x - y*y + x0
        y = 2*x*y + y0
        x = tmp
        i = i + 1
    WEND

    mand = i

END FUNCTION


FUNCTION colorizer (ival AS LONG) AS LONG
    REM max ival is 4096

    DIM RED AS LONG
    DIM BLUE AS LONG
    DIM GREEN AS LONG

    IF IVAL = %ITERATIONS THEN
        COLORIZER = 0
    ELSE
        BLUE  = ival AND &H0000000f
        GREEN = ival AND &H000000f0
        RED   = ival AND &H00000f00


        ROTATE RIGHT GREEN, 4
        ROTATE RIGHT RED,   8

        ROTATE LEFT BLUE, 4
        ROTATE LEFT GREEN, 4
        ROTATE LEFT RED, 4

        REM print RED,GREEN,BLUE
        colorizer = RGB(red, green, blue) AND &h00FFFFFF
    END IF
END FUNCTION

Which makes things at least10x faster.
 
Top