Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Mandelbrot Set

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • PBWin Mandelbrot Set

    Just a little something I knocked up this evening for fun:
    For those not familiar with the Mandelbrot Set: https://en.wikipedia.org/wiki/Mandelbrot_set
    '
    Code:
    'Zoomable Mandlebrot Set
    'S. McLachlan June 2021
    
    #COMPILE EXE
    #DIM ALL
    ENUM ctrls SINGULAR
        idc_GR1 =1001
    END ENUM
    
    GLOBAL lngMaxIterations AS LONG
    GLOBAL dblZoomRate AS DOUBLE
    GLOBAL lngWidth  AS LONG
    GLOBAL lngHeight AS LONG
    GLOBAL dblRealStart AS DOUBLE
    GLOBAL dblRealEnd AS DOUBLE
    GLOBAL dblImaginStart AS DOUBLE
    GLOBAL dblImaginEnd AS DOUBLE
    GLOBAL lngColours() AS LONG
    GLOBAL dblRealWidth AS DOUBLE
    GLOBAL dblImaginHeight  AS DOUBLE
    GLOBAL dblRealCentre AS DOUBLE
    GLOBAL dblImaginCentre AS DOUBLE
    GLOBAL dblCurrentZoom AS DOUBLE
    
    FUNCTION PBMAIN() AS LONG
    LOCAL x AS LONG
    LOCAL lRslt AS LONG
    LOCAL hDlg  AS DWORD
    'Init
        lngWidth =  800
        lngHeight = 600
        lngMaxIterations = 500
        dblZoomRate = 3
        dblCurrentZoom = 1
        dblRealCentre = 0
        dblImaginCentre = 0
        dblRealWidth = 4
        dblImaginHeight = 4
        GetBounds
    
        DIM lngColours(0 TO lngMaxIterations)
        RANDOMIZE
        FOR x = 0 TO lngMaxIterations -1
           lngColours(x) = RGB(RND(0,255),RND(0,255),RND(0,255))
        NEXT
        lngColours(lngMaxIterations) = RGB(0,0,0)
    
        DIALOG NEW PIXELS, 0, "Mandelbrot", , , lngWidth, lngHeight, %WS_SYSMENU, TO hDlg
        CONTROL ADD GRAPHIC, hDlg,%idc_gr1,"", 0,0, lngWidth,lngHeight
        GRAPHIC ATTACH hDlg,%IDC_Gr1,REDRAW
        plot
        DIALOG SHOW MODAL hDlg, CALL MainDlgCB TO lRslt
    END FUNCTION
    
    CALLBACK FUNCTION MainDlgCB()
        SELECT CASE AS LONG CB.MSG
            CASE %WM_RBUTTONUP
                dblRealCentre = dblRealStart + dblRealWidth*LO(WORD,CB.LPARAM)/lngWidth
                dblImaginCentre = dblImaginStart + dblImaginHeight*HI(WORD,CB.LPARAM)/lngHeight
                dblRealWidth = dblRealWidth * dblZoomRate
                dblImaginHeight = dblImaginHeight * dblZoomRate
                GetBounds
                dblCurrentZoom = dblCurrentZoom / dblZoomRate
                plot
                GRAPHIC REDRAW
                DIALOG SET TEXT CB.HNDL, "Mandelbrot  " & "Zoom: " & FORMAT$(dblCurrentZoom,3)
            CASE %WM_LBUTTONUP
                dblRealCentre = dblRealStart + dblRealWidth*LO(WORD,CB.LPARAM)/lngWidth
                dblImaginCentre = dblImaginStart + dblImaginHeight*HI(WORD,CB.LPARAM)/lngHeight
                dblRealWidth = dblRealWidth /dblZoomRate
                dblImaginHeight = dblImaginHeight /dblZoomRate
                GetBounds
                dblCurrentZoom = dblCurrentZoom * dblZoomRate
                plot
                GRAPHIC REDRAW
                DIALOG SET TEXT CB.HNDL, "Mandelbrot     " & "Zoom: x" & FORMAT$(dblCurrentZoom,"#####") & "       Centre: " & FORMAT$(dblRealCentre,"0.00") & "," & FORMAT$(dblImaginCentre,"0.00")
            CASE %WM_COMMAND
                SELECT CASE AS LONG CB.CTL
                END SELECT
        END SELECT
    END FUNCTION
    
    FUNCTION Plot() AS LONG
        LOCAL x,y,m AS LONG
        LOCAL  dblReal,dblImagin,dblTmpReal,dblTmpImagin, dblXFactor,dblYFactor,temp AS DOUBLE
        dblYFactor = dblImaginHeight/lngHeight
        dblXFactor = dblRealWidth/lngWidth
        FOR x = 0 TO lngWidth -1
            dblReal = dblRealStart + x * dblXFactor
            FOR y = 0 TO lngHeight -1
                dblTmpReal = 0 :dblTmpImagin = 0 :m=0
                dblImagin = dblImaginStart + y * dblYFactor
                 WHILE dblTmpReal*dblTmpReal + dblTmpImagin*dblTmpImagin <= 4 AND m < lngMaxIterations
                    temp = dblReal + dblTmpReal*dblTmpReal - dblTmpImagin*dblTmpImagin
                    dblTmpImagin = dblImagin + 2*dblTmpImagin*dblTmpReal
                    dblTmpReal = temp
                    INCR m
                WEND
                GRAPHIC SET PIXEL  (x, y) , lngColours(m)
            NEXT
        NEXT
    END FUNCTION
    
    SUB GetBounds
        dblRealStart = dblRealCentre - dblRealWidth/2
        dblRealEnd = dblRealCentre + dblRealWidth/2
        dblImaginStart = dblImaginCentre - dblImaginHeight/2
        dblImaginEnd = dblImaginCentre + dblImaginHeight/2
    END SUB
    '


  • #2
    Version 2 - Selectable random colours or rainbox spectrum
    (plus a few other tweaks)
    '
    Code:
    'Zoomable Mandlebrot Set v2
    'S. McLachlan June 2021
    
    #COMPILE EXE
    #DIM ALL
    #DEBUG ERROR ON
    #DEBUG DISPLAY ON
    ENUM ctrls SINGULAR
        idc_GR1 = 1001
    END ENUM
    
    GLOBAL glngMaxIterations AS LONG
    GLOBAL glngColours() AS LONG
    GLOBAL glngUseRandomColours AS LONG
    GLOBAL gdblZoomRate AS DOUBLE
    GLOBAL glngWidth  AS LONG
    GLOBAL glngHeight AS LONG
    GLOBAL gdblRealStart AS DOUBLE
    GLOBAL gdblRealEnd AS DOUBLE
    GLOBAL gdblImaginStart AS DOUBLE
    GLOBAL gdblImaginEnd AS DOUBLE
    GLOBAL gdblRealWidth AS DOUBLE
    GLOBAL gdblImaginHeight  AS DOUBLE
    GLOBAL gdblRealCentre AS DOUBLE
    GLOBAL gdblImaginCentre AS DOUBLE
    GLOBAL gdblCurrentZoom AS DOUBLE
    
    FUNCTION PBMAIN() AS LONG
    LOCAL lRslt AS LONG
    LOCAL hDlg  AS DWORD
    ' Application parameters
        glngWidth =  800   'window/image pixel width
        glngHeight = 600   'window/image pixel height
        glngMaxIterations = 500  'iteration count cutoff
        glngUseRandomColours = 0 '0 = spectrum, 1 = random colours
        gdblZoomRate = 10  'how much each click zooms
     'initialise display parameters to show full set.
        gdblCurrentZoom = 1
        gdblRealCentre = 0
        gdblImaginCentre = 0
        gdblRealWidth = 4
        gdblImaginHeight = 4
        GetBounds
     'Initialse colour scheme
        DIM glngColours(0 TO glngMaxIterations)
        RANDOMIZE 'initial colour set if UseRandomColours.
        GetColours
    
        DIALOG NEW PIXELS, 0, "Mandelbrot", , , glngWidth, glngHeight, %WS_SYSMENU, TO hDlg
        CONTROL ADD GRAPHIC, hDlg,%idc_gr1,"", 0,0, glngWidth,glngHeight
        GRAPHIC ATTACH hDlg,%IDC_Gr1,REDRAW
        DIALOG SET TEXT hDlg, "Mandelbrot  " & "Zoom: " & FORMAT$(gdblCurrentZoom,3) & "       Centre: 0,0"
        PlotIt
        DIALOG SHOW MODAL hDlg, CALL MainDlgCB TO lRslt
    END FUNCTION
    
    CALLBACK FUNCTION MainDlgCB()
        SELECT CASE AS LONG CB.MSG
            CASE %WM_HELP
                ? "Left Button Click = Zoom in x " & FORMAT$(gdblZoomRate) & $LF & _
                "Right Button Click = Zoom Out" & $LF & _
                "Middle button/Mouse wheel click = Reset and change colour scheme if random colours",,"MANDEBROT SET CONTROLS"
            CASE %WM_MBUTTONUP  'Reset to initial location and zoom
                gdblcurrentZoom = 1
                gdblRealCentre = 0
                gdblImaginCentre = 0
                gdblRealWidth = 4
                gdblImaginHeight = 4
                IF glngUseRandomColours THEN GetColours  'next random colour set
                GetBounds
                PlotIt
                GRAPHIC REDRAW
                DIALOG SET TEXT CB.HNDL, "Mandelbrot  " & "Zoom: " & FORMAT$(gdblCurrentZoom,3) & "       Centre: 0,0"
    
            CASE %WM_MOUSEMOVE 'Display current location of mouse within set
                gdblRealCentre = gdblRealStart + gdblRealWidth*LO(WORD,CB.LPARAM)/glngWidth
                gdblImaginCentre = gdblImaginStart + gdblImaginHeight*HI(WORD,CB.LPARAM)/glngHeight
                DIALOG SET TEXT CB.HNDL, "Mandelbrot  " & "Zoom: " & FORMAT$(gdblCurrentZoom,3) & _
                        "       Centre: " & FORMAT$(gdblRealCentre,"0.######") & "," & FORMAT$(gdblImaginCentre,"0.######")
    
                CASE %WM_RBUTTONUP 'back up one zoome level
                gdblRealCentre = gdblRealStart + gdblRealWidth*LO(WORD,CB.LPARAM)/glngWidth
                gdblImaginCentre = gdblImaginStart + gdblImaginHeight*HI(WORD,CB.LPARAM)/glngHeight
                gdblRealWidth *= gdblZoomRate
                gdblImaginHeight *= gdblZoomRate
                GetBounds
                gdblCurrentZoom /= gdblZoomRate
                PlotIt
                GRAPHIC REDRAW
                DIALOG SET TEXT CB.HNDL, "Mandelbrot  " & "Zoom: " & FORMAT$(gdblCurrentZoom,3) & _
                       "       Centre: " & FORMAT$(gdblRealCentre,"0.######") & "," & FORMAT$(gdblImaginCentre,"0.######")
    
             CASE %WM_LBUTTONUP 'zoom in by zoom factor
                gdblRealCentre = gdblRealStart + gdblRealWidth*LO(WORD,CB.LPARAM)/glngWidth
                gdblImaginCentre = gdblImaginStart + gdblImaginHeight*HI(WORD,CB.LPARAM)/glngHeight
                gdblRealWidth /= gdblZoomRate
                gdblImaginHeight /= gdblZoomRate
                GetBounds
                gdblCurrentZoom *= gdblZoomRate
                PlotIt
                GRAPHIC REDRAW
                DIALOG SET TEXT CB.HNDL, "Mandelbrot     " & "Zoom: x" & FORMAT$(gdblCurrentZoom,"#####") & _
                      "       Centre: " & FORMAT$(gdblRealCentre,"0.######") & "," & FORMAT$(gdblImaginCentre,"0.######")
        END SELECT
    END FUNCTION
    
    SUB PlotIt()
        LOCAL x,y,m AS LONG
        LOCAL  dblReal,dblImagin,dblTmpReal,dblTmpImagin, dblXFactor,dblYFactor,temp AS DOUBLE
        dblYFactor = gdblImaginHeight/glngHeight
        dblXFactor = gdblRealWidth/glngWidth
        FOR x = 0 TO glngWidth -1
            dblReal = gdblRealStart + x * dblXFactor
            FOR y = 0 TO glngHeight -1
                dblTmpReal = 0 :dblTmpImagin = 0 :m=0
                dblImagin = gdblImaginStart + y * dblYFactor
                 WHILE dblTmpReal*dblTmpReal + dblTmpImagin*dblTmpImagin <= 4 AND m < glngMaxIterations
                    temp = dblReal + dblTmpReal*dblTmpReal - dblTmpImagin*dblTmpImagin
                    dblTmpImagin = dblImagin + 2*dblTmpImagin*dblTmpReal
                    dblTmpReal = temp
                    INCR m
                WEND
                GRAPHIC SET PIXEL  (x, y) , glngColours(m)
            NEXT
        NEXT
    END SUB
    
    SUB GetBounds
        gdblRealStart = gdblRealCentre - gdblRealWidth/2
        gdblRealEnd = gdblRealCentre + gdblRealWidth/2
        gdblImaginStart = gdblImaginCentre - gdblImaginHeight/2
        gdblImaginEnd = gdblImaginCentre + gdblImaginHeight/2
    END SUB
    
    SUB GetColours
       LOCAL x AS LONG
          FOR x = 0 TO glngMaxIterations -1
           IF glngUseRandomColours THEN
                glngColours(x) = RGB(RND(0,255),RND(0,255),RND(0,255))
            ELSE
                glngColours(x) = HSLToRGB(x/(glngMaxIterations-1),1,.5) 'first param *2/3 = red to Blue (omitting blue to violet)
            END IF
        NEXT
        glngColours(glngMaxIterations) = RGB(0,0,0)
    END SUB
    
    '* Converts a HSL (Hue, Saturation,Lumnance )color value to RGB.
    '*  h, s, and l are  in the range 0 -1
    FUNCTION HSLToRGB(hue AS EXT, sat AS EXT, lum AS EXT) AS LONG
        LOCAL r,g,b,p,q AS EXT
        IF sat <> 0 THEN
            IF lum < 0.5 THEN
                q = lum * (1 + sat)
            ELSE
                q = lum + sat - lum * sat
            END IF
            p = 2 * lum - q
            r = HueToRGB(p, q, hue + 1/3)
            g = HueToRGB(p, q, hue)
            b = HueToRGB(p, q, hue - 1/3)
        END IF
        FUNCTION = RGB(r * 255, g * 255, b * 255)
    END FUNCTION
    FUNCTION HueToRGB(p AS EXT, q AS EXT, t AS EXT) AS EXT
        IF (t < 0) THEN
            t += 1
        ELSEIF (t > 1) THEN
            t -= 1
        END IF
        IF (t < 1/6) THEN FUNCTION =  p + (q - p) * 6 * t : EXIT FUNCTION
        IF (t < 1/2) THEN FUNCTION =  q : EXIT FUNCTION
        IF (t < 2/3) THEN FUNCTION = p + (q - p) * (2/3 - t) * 6 : EXIT FUNCTION
        FUNCTION = p
    END FUNCTION
    '

    Comment

    Working...
    X