FRTM Sample -- Koch Curves

結果

ワード定義

: pre 5 copy drop ;
: genx 3 ndup 6 ndup - * minus 100 / swap 4 ndup 7 ndup - * 100 / + 5 ndup +
  5 nrotr 4 ndrop ;
: geny swap 3 ndup 6 ndup - * 100 / swap 4 ndup 7 ndup - * 100 / + 4 ndup +
  5 nrotr 4 ndrop ;
: gen 6 copy genx 7 nrotr geny ;
: keep 7 nrotr 7 nrotr pre ;
: post 9 nrot 9 nrot 4 nrot 4 nrot 5 ndup 1- ;
: line moveto lineto ;
: koch dup 0= if drop line else 
    pre 0 0 gen keep 33 0 gen post koch
    pre 33 0 gen keep 50 -28 gen post koch
    pre 50 -28 gen keep 66 0 gen post koch
    pre 66 0 gen keep 100 0 gen post koch
    5 ndrop
  endif ;
: kochs 10 setcolor  89 440 551 440 4 koch
        11 setcolor 551 440 320  40 4 koch
        12 setcolor 320  40  89 440 4 koch ;
gm kochs
tm