L-system fractal

Уже занимался этой задачей, но забыл со временем и вновь вернулся к фракталам. В коде есть пара недостатков:  не подсчитывается размер изображения и обработка аксиом реализована без команды "f" и без обработки всех заглавных букв A..Z.

Global da=60
Global Dim s.f(650*8)
Procedure.s gen(a.s,r1.s,r2.s)
  r.s=""
  For i=1 To Len(a)
    If Mid(a,i,1)=Mid(r1,1,1)
      r=r+Mid(r1,2)
    ElseIf Mid(a,i,1)=Mid(r2,1,1)
      r=r+Mid(r2,2)
    Else
      r=r+Mid(a,i,1)
    EndIf
  Next i
  ProcedureReturn r
EndProcedure
Procedure drawl(a.s)
; f move forward one base length without painting
; F, G move forward one base length With painting
; + rotate left by the standard angle
; − rotate right by the standard angle
; [ save position And direction
; ] Restore position And direction
  an.f=0
  ra=5
  tx.f=450
  ty.f=0
  sp=0
  da=60
  For i=1 To Len(a)
    Select Mid(a,i,1)
      Case "F","X","Y"
        ttx.f=tx+ra*Cos(an*#PI/180)
        tty.f=ty+ra*Sin(an*#PI/180)
        LineXY(tx,ty,ttx,tty,$FFFFFF)
        tx=ttx
        ty=tty
      Case "-"
        an=an-da
      Case "+"
        an=an+da
      Case "["
        s(sp)=an
        s(sp+1)=tx
        s(sp+2)=ty
        sp=sp+3
      Case "]"
        sp=sp-3
        an=s(sp)
        tx=s(sp+1)
        ty=s(sp+2)
      Default:
        ;Debug Mid(a,i,1)
        End
    EndSelect
  Next i
EndProcedure
If OpenWindow(0, 0, 0, 650, 650, "L-System", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  CanvasGadget(0, 0, 0, 650, 650)
  
  axiom.s="XF"
  rule1.s="XX+YF++YF-FX--FXFX-YF+"
  rule2.s="Y-FX+YFYF++YF+FX--FX-Y"
  For i=1 To 4
    axiom=gen(axiom,rule1,rule2)
  Next i
  ;Debug axiom
  If StartDrawing(CanvasOutput(0))
    Box(0,0,650,650,0)
    Drawl(axiom)
    StopDrawing()
  EndIf
  Repeat

    Event = WaitWindowEvent()
  Until Event = #PB_Event_CloseWindow
EndIf

Второй вариант вышел попроще:

Global da=60

Global Dim s.f(650*8)

Procedure.s gen(a.s,r1.s)

  r.s=""

  For i=1 To Len(a)

    If Mid(a,i,1)="F"

      r=r+r1

    Else

      r=r+Mid(a,i,1)

    EndIf

  Next i

  ProcedureReturn r

EndProcedure

Procedure drawl(a.s)

  an.f=0

  ra.f=3.94

  tx.f=35*0

  ty.f=35*0

  sp=0

  For i=1 To Len(a)

    Select Mid(a,i,1)

      Case "F"

        ttx.f=tx+ra*Cos(an*#PI/180)

        tty.f=ty+ra*Sin(an*#PI/180)

        LineXY(tx,ty,ttx,tty,$FFFFFF)

        tx=ttx

        ty=tty

      Case "-"

        an=an-da

      Case "+"

        an=an+da

      Case "["

        s(sp)=an

        s(sp+1)=tx

        s(sp+2)=ty

        sp=sp+3

      Case "]"

        sp=sp-3

        an=s(sp)

        tx=s(sp+1)

        ty=s(sp+2)

    EndSelect

  Next i

EndProcedure

If OpenWindow(0, 0, 0, 320, 320, "L-System", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

  CanvasGadget(0, 0, 0, 320, 320)

  

  axiom.s="F+F+F+F"

  rule1.s="FF+F++F+F"

  da=90

  For i=1 To 4

    axiom=gen(axiom,rule1)

  Next i

  If StartDrawing(CanvasOutput(0))

    Box(0,0,320,320,0)

    Drawl(axiom)

    StopDrawing()

  EndIf

  Repeat

    Event = WaitWindowEvent()

  Until Event = #PB_Event_CloseWindow

EndIf

Теперь, когда готов код, можно накодить на  PicoCalc, но вылезла одна проблема: на MMBasic ограничена длина строк - до 255 байт, поэтому процедура генерации выдает ошибку. Подумав немного, я решил использовать файлы 1.txt - 5.txt

'Lindenmayer fractals

'Due to the 255-byte string length limit, this program writes data to files 1.txt, 2.txt...5.txt

CLS

ax$="F+F+F+F"'axiom

ru$="FF+F++F+F"'rule

Open "A:\1.txt" For output As #1

Print #1,ax$

Close #1

For i=1 To 4'iterations

Open "A:\"+Str$(i)+".txt" For input As #1

Open "A:\"+Str$(i+1)+".txt" For output As #2

Do

r$=Input$(1,#1)

If r$="F" Then

Print #2,ru$;

Else

Print #2,r$;

EndIf

Loop Until Eof(#1)

Close #1

Close #2

Kill "A:\"+Str$(i)+".txt"

Next i

'draw

an!=0

ra!=3.94

tx!=0

ty!=0

sp%=0

da!=90

Dim s(15000) As float

Open "A:\5.txt" For input As #1

Do

r$=Input$(1,#1)

If r$="F" Then

ttx!=tx!+ra!*Cos(an!*Pi/180)

tty!=ty!+ra!*Sin(an!*Pi/180)

Line tx,ty,ttx,tty

tx=ttx

ty=tty

EndIf

If r$="-" Then

an!=an!-da!

EndIf

If r$="+" Then

an!=an!+da!

EndIf

If r$="[" Then

s(sp%)=an!

s(sp%+1)=tx!

s(sp%+2)=ty!

sp%=sp%+3

EndIf

If r$="]" Then

sp%=sp%+3

an!=s(sp%)

tx!=s(sp%+1)

ty!=s(sp%+2)

EndIf

Loop Until Eof(#1)

Close #1

Запись строк сделана через )(, команда print #n дописывает конец строки $0D,$0A, даже если не просили. Но эта программа нарисовала фрактал, и я остановился на этом варианте: