NetaTaneMenu >>>> 羊歯 >>>> L-system
*L-system
----
図は下の十進ベーシックのソースで描いたもの。
! L-system program
! L-system structure G=(V,S,O,P)
! V:variables 所謂構成用文字。増やしてもらって結構です。
LET V$="ABCDEF"
! S:constants
LET S$="+-[]{}"
! O:initiator ルールに依存します。
LET O$="A"
! P:rules 幾つかのルールとその書式です。
!LET P$="(A->AB)(B->CA)(C->BA)"
!LET P$="(A->AB)(B->A)" ! Algae
!LET P$="(A->B)(B->AB)" ! Fibonacci
!LET P$="(A->ABA)(B->BBB)" ! Cantor Set
!
!LET O$="F" ! Koch
!LET P$="(F->F+F-F-F+F)" ! Koch
!LET P$="(A->B-A-B)(B->A+B+A)" ! Sierpinski triangle
!LET P$="(A->F[B]C)(B->C)(C->F{D}A)(D->A)" ! ぼちぼち複雑な木
!LET P$="(A->F[A]{A})(B->A)(C->F{D}A)(D->A)" ! 単純な二分木
LET P$="(A->F[B]C)(B->C)(C->F{D}A)(D->A)" ! 少々複雑な木
! main
PRINT O$ ! とりあえず最初の形を「テキスト出力」に出力
FOR i=1 TO 12 ! ルールを何回適用するか
LET L$=Lsystem$(V$,S$,O$,P$,i) ! ルールを適用する関数
PRINT L$ ! 「テキスト出力」に出力
NEXT i
! 以下はグラフィック出力用の設定と実行
SET WINDOW -4,4,-1,7
RANDOMIZE
! グラフィック出力のサブルーチン
!CALL GLsystem(l$,V$,S$,0,0,90,1,32,0.5,0,0.1,3,60,0.8,55,65)
CALL GLsystem(l$,V$,S$,0,0,90,1,32,0.5,0,0.1,3,60,0.75,1.1,0.9,55,45)
! EXTERNAL SUB glsystem(x$,v$,s$,x,y,d,l,w,cR,cG,cB,s,t,tr,tl,r,rr,rl)
! (x,y)は描き始めるポイント dは方向 lは長さ wは太さ
! (cR,cG,cB)はRGB色
! sはターンの角度
! tは(+-での)ターンの角度
! tr,tlは右枝，左枝の出る角度
! rは1つ深く入った時の長さの比率
! rrは右枝のrlは左枝の長さの比率
END
!
! 以上がメインプログラム。以下が外部関数及びルーチン
!==============
! L-system関数
!==============
EXTERNAL FUNCTION Lsystem$(v$,s$,o$,p$,n)
! L-system G=(v$,s$,o$,p$) を n 回変換します。再帰呼び出し？
IF n=0 THEN ! n=0 なら終了条件
LET Lsystem$=o$
ELSE
LET l=LEN(o$) ! 元の文字列の長さを測り
LET no$="" ! 空の文字列 no$を用意してここに答えを
FOR i=1 TO l ! 文字列の先頭から順に
LET ox$=o$(i:i) ! 一文字ずつ ox$に収めて
IF POS(v$,ox$)>0 THEN ! 変数なら
LET no$=no$&rule$(p$,ox$) ! ルールを適用したものを応えに付け加え
ELSEIF POS(s$,ox$)>0 THEN ! 定数なら
LET no$=no$&ox$ ! そのままを付け加え
ELSE ! ルールや変数指定の間違いがあれば
PRINT "<";ox$;"> ***** L-SYSTEM ERROR ***** " ! エラー表示
END IF ! という場合分けを
NEXT i ! 最後の一文字まで繰り返します。
LET Lsystem$=Lsystem$(v$,s$,no$,p$,n-1) ! で再帰します。
END IF
END FUNCTION
!==============
! L-system関数で呼ばれるルール適用関数
!==============
EXTERNAL FUNCTION rule$(r$,x$)
LET l=LEN(r$) ! パターンマッチングです。
LET p=POS(r$,"("&x$) ! "(X->Y･･･"の形で個別のルールが始まるので
IF p>0 THEN ! マッチするルールがあれ ば
LET rr$=r$(p+4:l) ! 適用部分の->以降のルール文字列を取り出し
LET p=POS(rr$,")") ! そのルールの終り")"の位置をみつけたら
!PRINT rr $
LET rule$=rr$(1:p-1) ! そこまでが，ルールを適用した結 果
ELSE ! なのでそれを返すわけです。
LET rule$=x$ ! マッチしなければ変化無し
END IF
END FUNCTION
!==============
! グラフィックス用サブルーチン
!==============
EXTERNAL SUB glsystem(x$,v$,s$,xx,yy,dd,ll,ww,ccR,ccG,ccB,s,t,r,rr,rl,tr,tl)
! (x,y)は描き始めるポイント dは方向 lは長さ
! sは1つ深くなったときのターンの角度
! tは(+-での)ターンの角度
! rは1つ深く入った時の長さの比率
! tr,tlは[]{}で枝分かれした時の,枝分かれの角度
OPTION ANGLE DEGREES
LET x=xx
LET y=yy
LET d=dd
LET l=ll
LET cR=ccR
LET cG=ccG
LET cB=ccB
SET COLOR MIX(1) cR,cG,cB
LET w=ww
SET LINE WIDTH w
PLOT LINES : x,y;
LET xl=LEN(x$)
DO WHILE xl>0
LET ox$=x$(1:1)
IF POS(v$,ox$)>0 THEN
LET x=x+l*COS(d)
LET y=y+l*SIN(d)
SET LINE WIDTH w
PLOT LINES : x,y;
LET l=l*r
LET w=w*r
LET d=d+s
LET tr=tr-ABS(s)
LET tl=tl-ABS(s)
ASK COLOR MIX(1) cR,cG,cB
LET cR=cR*RND !cR/(1+RND)
LET cG=cG+(1-cG)/(5+RND*10)
LET cB=cB/(1+RND)
SET COLOR MIX(1) cR,cG,cB
ELSEIF POS("+-",ox$)>0 THEN
IF ox$="+" THEN LET d=d+t ELSE LET d=d-t
ELSEIF POS("[{",ox$)>0 THEN
LET hx$=head$(x$)
LET x$=" "&tail$(x$)
IF ox$="[" THEN
CALL glsystem(hx$,v$,s$,x,y,d+tl,l/r*rl,w,cR,cG,cB,-s,t,r,rr,rl,tr-ABS(s),tl-ABS(s))
ELSE
CALL glsystem(hx$,v$,s$,x,y,d-tr,l/r*rr,w,cR,cG,cB,s,t,r,rr,rl,tr-ABS (s),tl-ABS(s))
END IF
PLOT LINES
PLOT LINES : x,y;
SET COLOR MIX(1) cR,cG,cB
END IF
LET x$=x$(2:xl)
LET xl=LEN(x$)
IF xl=0 THEN
SET AREA COLOR 4
DRAW disk WITH SCALE(0.02)*SHIFT(x,y)
END IF
LOOP
END SUB
!==============
! glsystemで呼ばれる文字列の枝を返す関数
!==============
EXTERNAL FUNCTION head$(x$)
LET ox$=x$(1:1)
IF ox$="[" THEN
LET ck1$="["
LET ck2$="]"
ELSE
LET ck1$="{"
LET ck2$="}"
END IF
LET lx=LEN(x$)
LET ax$=x$(2:lx)
LET lx=lx-1
LET ans$=""
LET i=1
LET k=1
DO WHILE k>0
LET ox$=ax$(i:i)
IF ox$=ck1$ THEN
LET k=k+1
ELSEIF ox$=ck2$ THEN
LET k=k-1
END IF
IF k>0 THEN LET ans$=ans$&ox$
LET i=i+1
LOOP
!PRINT ans$
LET head$=ans$
END FUNCTION
!==============
! glsystemで呼ばれる文字列の本体の残りを返す関数
!==============
EXTERNAL FUNCTION tail$(x$)
LET ox$=x$(1:1)
IF ox$="[" THEN
LET ck1$="["
LET ck2$="]"
ELSE
LET ck1$="{"
LET ck2$="}"
END IF
LET lx=LEN(x$)
LET ax$=x$(2:lx)
LET lx=lx-1
LET i=1
LET k=1
DO WHILE k>0
LET ox$=ax$(i:i)
IF ox$=ck1$ THEN
LET k=k+1
ELSEIF ox$=ck2$ THEN
LET k=k-1
END IF
LET i=i+1
LOOP
LET ans$=ax$(i:lx)
!PRINT ans$
LET tail$=ans$
END FUNCTION
rubyやproccessindg（？でしたっけ）で描けばもっとインタラクティブだったり
コードが見易かったりするのだとは思うのですが，
現場ではまだまだベーシックなような気がするのとお手軽さで。
![[PukiWiki]](image/pukiwiki.png "[PukiWiki]")
