Программа построения двухмерных L-фракталов (язык QBasic) .

' Функция рисования фрактала
DECLARE FUNCTION LDRAW (x0#, y0#, ST#, direct#, LS$)

' Функция получения строки для рисования фрактала
DECLARE FUNCTION LSTRING$ (axiom$, RC, RULES$( ), N, LS$)

' Функция читает данные из файла filename$ и возвращает:
' строка axiom$ - аксиома,
' direct# - число для получения угла поворота
' RC - количество теорем
' массив строк RULES$ - правила
DECLARE FUNCTION READFRA (filename$, axiom$, direct#, RC, RULES$( ) )
' Формат файла данных:
' 1-я строка - аксиома
' 2-я строка - число, на которое надо разделить 360 для получения
' угла поворота
' 3-я строка - число, равное количеству правил
' строки (количество которых определено в 3-й строке),
' в каждой из которых записано по одному правилу
' строки не содержат пробелов, 1-й элемент - заменяемый символ,
' остальные элементы - символы, на которые заменяется 1-й

' Функции преобразования координат
DECLARE FUNCTION XE# (x#)
DECLARE FUNCTION YE# (y#)

DIM RULES$(10)
N = READFRA("dragon.fra", axiom$, direct#, RC, RULES$ ( ) )
LS$ = LSTRING$(axiom$, RC, RULES$( ), 9, LS$)
PRINT LS$
Z$ = ""
DO WHILE Z$ = ""
Z$ = INKEY$
LOOP
SCREEN 12
COLOR 15
N = LDRAW(-200#, 0#, 10#, direct#, LS$)
Z$ = ""
DO WHILE Z$ = ""
Z$ = INKEY$
LOOP

FUNCTION LDRAW (x0#, y0#, ST#, direct#, LS$)
CONST PI# = 3.141592654#
x# = x0#
x# = y0#
rangle# = ((360# / direct#)) * PI# / 180#
curangle# = 0#
DIM stackX(200)
DIM stackY(200)
DIM stackANG#(200)
PSTACK = 0
COLOR 15
PSET (CINT(XE(x#)), CINT(YE(y#)))
I=1
DO WHILE (I < LEN (LS$) )
     A$ = MID$(LS$, I, 1)
     SELECT CASE A$
            CASE "F"
               x# = x# + ST# * COS(curangle#)
               y# = y# + ST# * SIN(curangle#)
               LINE-(CINT(XE(x#)), CINT(YE ( (y#)))), 15
            CASE "+"
               curangle# = curangle# - rangle#
            CASE "-"
               curangle# = curangle# + rangle#
            CASE "["
                 PSTACK = PSTACK + 1
                 stackX(PSTACK) = x#
                 stackY(PSTACK) = y#
                 stackANG#(PSTACK) = curangle#
            CASE "]"
                 x# = stackX(PSTACK)
                 y# = stackY(PSTACK)
                 curangle# = stackANG#(PSTACK)
                 PSTACK = PSTACK - 1
                 PSET (CINT(XE(x#)), CINT(YE(y#) ) )
                 COLOR 15
     END SELECT
     I=I+1
LOOP
END FUNCTION

FUNCTION LSTRING$ (axiom$, RC, RULES$ ( ), N, LS$)
     LS$ = axiom$
     R$ = ""
     RESULT$ = LS$
     FOR I = 0 TO N - 1
          К = 1
          Kl = LEN(RESULT$)
          WHILE (K < LEN(RESULT$))
                J = 0
                IF (K > Kl) THEN
                   К = 1
                END IF
                WHILE ((J <= RC - 1) AND (K <= Kl))
                    A$ = MID$(RESULT$, K, 1)
                    B$ = MID$(RULES$(J) , 1, 1)
                    IF (A$ = B$) THEN
                        SHIFT = LEN(RULES$(J)) - 2
                        P = K - 1
                        A$ = MID$(RESULT$, 1, P)
                        B$ = MID$(RULES$(J), 2, LEN(RULES$(J)) - 2)
                        С$ = MID$(RESULT$, К + 1, LEN(RESULT$) - К)
                        R$ = A$ + B$
                        R$ = R$ + C$
                        RESULT$ = R$
                        Kl = LEN(RESULT$)
                        К = К + SHIFT + 1
                    ELSE J = J + 1
                    END IF
                WEND
                К = К + 1
          WEND
NEXT I
LSTRING$ = RESULT$
END FUNCTION

FUNCTION READFRA (filename$, axiom$, direct#, RC, RULES$( ))
     OPEN filename$ FOR INPUT AS #1
     LINE INPUT #1, axiom$
     axiom$ = axiom$ + " "
     LINE INPUT #1, DIR$
     direct# = VAL(DIR$)
     LINE INPUT #1, RC$
     RC = VAL(RC$)
     FOR I = 0 TO RC - 1
          LINE INPUT #1, RULES$(I)
          RULES$(I) = RULES$(I) + " "
     NEXT I
     CLOSE #1
END FUNCTION

FUNCTION XE# (x#)
  XE# = 320 + x#
END FUNCTION

FUNCTION YE# (y#)
  YE# = 240 - y#
END FUNCTION