'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ-Ä-Äúú ú
'³ *** Mandelbrot fractal ***
'³
'³ by SkurK/b.  (skurk@multinet.no)
'ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ-Ä-Äúú ú
'
'   Input/draw/save engine tweaked by Tim Williams, 09-02-2004.

DEFDBL A-Z

DECLARE SUB Render ()
DECLARE FUNCTION Colr$ (d%)

DIM SHARED Scale AS SINGLE, Ac AS INTEGER, xShift, yShift, xSize, ySize
DIM SHARED Detail AS LONG, k$, File$, Save AS INTEGER

SCREEN 18
Ac = 16
Detail = 4
Scale = 1
xSize = 640
ySize = 480
Doit = 1
xShift = -xSize / 2: yShift = -ySize / 2
DO
    k$ = UCASE$(INKEY$)
    IF k$ = "=" OR k$ = "+" THEN
        Scale = Scale * 2
        yShift = (yShift + ySize / 2) * 2 - ySize / 2
        xShift = (xShift + xSize / 2) * 2 - xSize / 2
        Doit = 1
    END IF
    IF (k$ = "-" OR k$ = "_") AND Scale > 1 THEN
        Scale = Scale / 2
        yShift = (yShift + ySize / 2) / 2 - ySize / 2
        xShift = (xShift + xSize / 2) / 2 - xSize / 2
        Doit = 1
    END IF
    IF k$ = CHR$(255) + "K" THEN xShift = xShift - 60: Doit = 1
    IF k$ = CHR$(255) + "M" THEN xShift = xShift + 60: Doit = 1
    IF k$ = CHR$(255) + "H" THEN yShift = yShift - 40: Doit = 1
    IF k$ = CHR$(255) + "P" THEN yShift = yShift + 40: Doit = 1
    IF k$ = "A" THEN
        LOCATE 1, 1: PRINT STRING$(40, 32);
        LOCATE 1, 1: INPUT "New recursion value:", Ac
        Doit = 1
    END IF
    IF k$ = "1" THEN Detail = 1: Doit = 1
    IF k$ = "2" THEN Detail = 2: Doit = 1
    IF k$ = "3" THEN Detail = 3: Doit = 1
    IF k$ = "4" THEN Detail = 4: Doit = 1
    IF k$ = "5" THEN Detail = 5: Doit = 1
    IF k$ = "6" THEN Detail = 6: Doit = 1
    IF k$ = "7" THEN Detail = 7: Doit = 1
    IF k$ = "8" THEN Detail = 8: Doit = 1
    IF k$ = "9" THEN Detail = 9: Doit = 1
    IF k$ = "S" THEN
        LOCATE 1, 1: PRINT STRING$(40, 32);
        LOCATE 1, 3: INPUT "Filename:", File$
        IF File$ > "" THEN Save = 1: Doit = 1
    END IF
    IF k$ = "L" THEN
        LOCATE 1, 1: PRINT STRING$(40, 32);
        LOCATE 1, 1: PRINT xShift; yShift; LOG(Scale) / LOG(2);
    END IF
    IF k$ = CHR$(27) THEN EXIT DO
    IF Doit THEN Doit = 0: Render
LOOP

DEFINT A-Z
'   Select the R,G,B (or whatever arrangement you like your RAW files in)
'   colors to write.  This starts in bluescale then goes to a bunch of others.
'   If you really felt like taking the time, you could expand it to all 16.7M
'   colors, but how to calculate a palette?
FUNCTION Colr$ (d)
WHILE d >= 256: d = d - 256: WEND
    'Limit d to 1785 for multicolor
'    IF d >= 0 AND d < 255 THEN a = 0: b = 0: c = d
'    IF d >= 255 AND d < 510 THEN a = 0: b = d - 255: c = 255
'    IF d >= 510 AND d < 765 THEN a = 0: b = 255: c = 765 - d
'    IF d >= 765 AND d < 1020 THEN a = d - 765: b = 255: c = 0
'    IF d >= 1020 AND d < 1275 THEN a = 255: b = 1275 - d: c = 0
'    IF d >= 1275 AND d < 1530 THEN a = 255: b = 0: c = d - 1275
'    IF d >= 1530 AND d < 1785 THEN a = 255: b = d - 1530: c = 255
'    Colr$ = CHR$(a) + CHR$(b) + CHR$(c)
    'Limit d to 255 for monochrome
    Colr$ = CHR$(d) + CHR$(d) + CHR$(d)
END FUNCTION

DEFDBL A-Z
'   Draw the Mandelbrot dealie
SUB Render
    DIM Count AS INTEGER
    LOCATE 1, 1: PRINT STRING$(40, 32);
    LOCATE 1, 1: PRINT "Recursion:"; Ac; " Detail:"; Detail;
    LOCATE 1, 30: PRINT "Drawing..."
    IF Save = 1 THEN
    '   Saves a 1920 x 1440 (give or take one) R-G-B interlaced .RAW image file
        OPEN File$ + ".raw" FOR OUTPUT AS #1
        'SCREEN 0
        FOR y = 0 TO ySize STEP Detail / 3
            FOR x = 0 TO xSize STEP Detail / 3
                Rc = (x + xShift) * 2 / (xSize * Scale)
                Ic = (y + yShift) * 2 / (ySize * Scale)
                Rz = 0: Iz = 0: Count = 0
                DO
                    Tempz = Rz * Rz - Iz * Iz + Rc
                    Iz = 2 * Rz * Iz + Ic
                    Rz = Tempz
                    Count = Count + 1
                    Size = Rz * Rz + Iz * Iz
                LOOP UNTIL Count = Ac OR Size > 4
                PRINT #1, Colr$(Count);
                PSET (x, y), Count
            NEXT x
            'LOCATE 1, 1: PRINT y
        NEXT y
        CLOSE #1
        'PRINT "Done."
        'WHILE INKEY$ = "": WEND
        'SCREEN 13
        Save = 0
    ELSE
    FOR y = 16 TO ySize STEP Detail
        FOR x = 0 TO xSize STEP Detail
            Rc = (x + xShift) * 2 / (xSize * Scale)
            Ic = (y + yShift) * 2 / (ySize * Scale)
            Rz = 0: Iz = 0: Count = 0
            DO
                Tempz = Rz * Rz - Iz * Iz + Rc
                Iz = 2 * Rz * Iz + Ic
                Rz = Tempz
                Count = Count + 1
                Size = Rz * Rz + Iz * Iz
            LOOP UNTIL Count >= Ac OR Size > 4
            IF Detail = 1 THEN PSET (x, y), Count ELSE LINE (x, y)-(x + Detail - 1, y + Detail - 1), Count, BF
            IF INKEY$ > "" THEN y = ySize: x = xSize
    NEXT x, y
    END IF
    LOCATE 1, 30: PRINT STRING$(11, 32);
END SUB