'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ-Ä-Äúú ú
'³ *** Mandelbrot fractal ***
'³
'³ by SkurK/b.  (skurk@multinet.no)
'ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ-Ä-Äúú ú
'
'   Modified by Tim Williams, 09-03-2004.

DEFDBL A-Z
DECLARE SUB Render ()
DECLARE FUNCTION Colr$ (c%)
DIM SHARED Scale AS SINGLE, Ac AS INTEGER, xShift, yShift, xSize, ySize, Detail AS LONG, k$, File$, Save AS INTEGER

SCREEN 13
'Initials
Ac = 16
Detail = 4
Scale = 1
xSize = 320
ySize = 200
Go = 1
xShift = -xSize / 2: yShift = -ySize / 2
'Main loop
DO
    k$ = UCASE$(INKEY$)
    IF k$ = "=" OR k$ = "+" THEN
    '   Zoom in
        Scale = Scale * 2
        yShift = (yShift + ySize / 2) * 2 - ySize / 2
        xShift = (xShift + xSize / 2) * 2 - xSize / 2
        Go = 1
    END IF
    IF (k$ = "-" OR k$ = "_") AND Scale > 1 THEN
    '   Zoom out
        Scale = Scale / 2
        yShift = (yShift + ySize / 2) / 2 - ySize / 2
        xShift = (xShift + xSize / 2) / 2 - xSize / 2
        Go = 1
    END IF
    IF LEN(k$) = 2 THEN
    '   I forgot how to detect arrow keys so I'm doing it in this roundabout way.
        k% = CVI(k$)
        IF k% = 19200 THEN xShift = xShift - 60: Go = 1
        IF k% = 19712 THEN xShift = xShift + 60: Go = 1
        IF k% = 18432 THEN yShift = yShift - 40: Go = 1
        IF k% = 20480 THEN yShift = yShift + 40: Go = 1
    END IF
    IF k$ = "A" THEN
        LOCATE 1, 1
        PRINT STRING$(40, 32);
        LOCATE 1, 1
        INPUT "New recursion value:", Ac
    '   Sets how deep the recursive function goes before giving up.
        Go = 1
    END IF
'   Detail levels to speed up movement.  Set to 1 before writing a file!
    IF k$ = "1" THEN Detail = 1: Go = 1
    IF k$ = "2" THEN Detail = 2: Go = 1
    IF k$ = "3" THEN Detail = 3: Go = 1
    IF k$ = "4" THEN Detail = 4: Go = 1
    IF k$ = "5" THEN Detail = 5: Go = 1
    IF k$ = "6" THEN Detail = 6: Go = 1
    IF k$ = "7" THEN Detail = 7: Go = 1
    IF k$ = "8" THEN Detail = 8: Go = 1
    IF k$ = "9" THEN Detail = 9: Go = 1
    IF k$ = "S" THEN
    '   Saves a file: to skip, enter a blank filename.
        LOCATE 1, 1: PRINT STRING$(40, 32);
        LOCATE 1, 3: INPUT "Filename:", File$
        IF File$ > "" THEN Save = 1: Go = 1
    END IF
    IF k$ = CHR$(27) THEN EXIT DO
    IF Go THEN Go = 0: Render
LOOP

DEFINT A-Z
'   Sets what kind of bytes are written to file.  You could go with one byte
'   per pixel grayscale or paletted just as well.  However, This way you can
'   set color proportions as written.
FUNCTION Colr$ (c)
    Colr$ = CHR$(c) + CHR$(c) + CHR$(c)
END FUNCTION

DEFDBL A-Z
'   Draw the Mandelbrot dealie
SUB Render
    DIM Count AS INTEGER
'   Display vital information
    LOCATE 1, 1: PRINT STRING$(40, 32);
    LOCATE 1, 1: PRINT "Recursion:"; Ac; " Detail:"; Detail;
    LOCATE 1, 30: PRINT "Drawing..."
    IF Save = 1 THEN
        OPEN File$ + ".raw" FOR OUTPUT AS #1
    '   Records the same dimensions as display, but with 4 times the detail.
        FOR y = 0 TO ySize STEP Detail / 4
            FOR x = 0 TO xSize STEP Detail / 4
                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
                DO UNTIL Count < 512
                    Count = Count - 512
                LOOP
                IF Count >= 256 THEN Count = 512 - Count
                IF Count = 256 THEN Count = 0
                PRINT #1, Colr$(Count);
            '   Yeah, so drawing is rather wasted.  Tells you where it is though.
                PSET (x, y), Count
        NEXT x, y
        CLOSE #1
        Save = 0
    ELSE
    '   Set y = 16 to start if resolution has 16 pixel tall characters!
        FOR y = 8 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
            '   Cancel if key pressed during drawing (comes in handy...)
                IF INKEY$ > "" THEN y = ySize: x = xSize
        NEXT x, y
    END IF
'   And finally, erase "Drawing..." to indicate completion.  Or not.
    LOCATE 1, 30: PRINT STRING$(11, 32);
END SUB