\\             *** Bezierkurven ***                    01jul98py                                                                  Da es drei verschiedene Algorithmen zur Annäherung von        Bezierkurven gibt, sind hier alle drei angeführt.                 Optimal ist der von Pierre Bezier gefundene rekursive         Einhüll-Algorithmus im Scr 1 (der auch von TeX-Fonterzeuger     METAFONT benutzt wird).                                           Bekannter ist der Algorithmus in Scr 2, der eine beliebige    Anzahl von Kurvenpunkten findet, indem er alle Strecken des     Polygons im Verhältnis t teilt (t=0..1), die Teilpunkte als     neues Polygon setzt und solange fortfährt, bis ein Punkt übrig- bleibt.                                                           Mathematisch ebenso korrekt, aber noch langsamer ist der      Algorithmus in Scr 3, der die Bezierkurvenpunkte mit dem        Bernstein-Polynom findet.                                                                                                       \ Bezierkurven (Einhüllung)                            01jul98py| : >sc >r r@ 2* 0 ?DO  i pick $10 <<      i pin  LOOP r> ;     | : sc> >r r@ 2* 0 ?DO  i pick $F >> 1+ 2/ i pin  LOOP r> ;     \ : 2>r >r >r ; macro                                           \ : 2r> r> r> ; macro                                           | : 2-rot 2swap 2>r 2swap 2r> ; macro                           | : z1/2  rot + 1+ 2/ >r + 1+ 2/ r> ;                           : >bezier ( z1 .. zn n d -- z1 .. zc c ) ?dup 0= ?exit  over      BEGIN 1- dup WHILE  >r 2over r> -rot 2>r -rot 2>r                  dup BEGIN 2>r 2over z1/2 2r> 2swap 2>r 1- dup 0= UNTIL drop     dup BEGIN 2r> 2swap 1- dup 0< UNTIL drop                     REPEAT drop                                                     2dup 2>r 1- recurse nip nip 2r> over 1-                         BEGIN  2r> 2-rot 1- dup 0= UNTIL  drop                          rot >r 1- recurse r> + 2- ;                                   \ GEM  : bezier >r >sc r> >bezier sc> pline ;   Onlyforth       \ Bezierkurven (Streckenteilung)                       01jul98py                                                                | : >sc >r r@ 2* 0 ?DO  i pick $10 <<      i pin  LOOP r> ;     | : sc> >r r@ 2* 0 ?DO  i pick $F >> 1+ 2/ i pin  LOOP r> ;     | : >calk ( n1 n2 u s -- n ) >r >r over - 2* r> r> */ 1+ 2/ + ; | : >next ( x1 y1 .. xn yn n u s -- x1 y1 .. xn-1 yn-1 n-1 u s )    rot 1- dup >r 2* 1- 0 swap                                      ?DO  i 4+ pick i 3+ pick 2over >calk i 4+ pin  -1 +LOOP         2swap 2drop  r> -rot ;                                      | : ndup dup 2* -1 DO  i' pick  LOOP ;                          : >bezier ( x1 y1 .. xn yn n s -- x1 y1 .. xs ys s )              dup >r 0 ?DO  ndup i i' 1- 2 pick 1 ?DO >next LOOP  2drop drop                2 pick 2* 2+ -roll  over 2* 2+ -roll  LOOP        0 ?DO  2drop  LOOP  r> ;                                                                                                      \ GEM  : bezier >r >sc r> >bezier sc> pline ;   Onlyforth       \ Bezierkurven (Bernstein-Polynom)                     01jul98py| : >sc >r r@ 2* 0 ?DO i pick $10 <<  i pin LOOP r> ;           | : sc> >r r@ 2* 0 ?DO i pick $F >> 1+ 2/ i pin LOOP r> ;       | : 2pick   2* 1+ dup >r pick  r> pick  ;                       | : 2-roll  2* 1+ dup >r -roll r> -roll ;                       | : r*   $8000 */ 1+ 2/ ;       | : v*   under r* >r r* r> ;    | : choose  ( n k -- n_k ) dup 0= IF  2drop 1 exit  THEN >r dup     r@ 1 ?DO 1- under * swap LOOP drop r> 1+ 1 ?DO i / LOOP ;   | : z^  ( x y t n -- )  0 ?DO dup >r v* r> LOOP drop ;          | : zsum  ( z1 .. zn t n -- z1 .. zn zs ) 0. 2swap                  0 ?DO  >r i 1+ 2pick r@ i' i - 1- z^ $10000 r@ - i z^                  i' 1- i choose v* pair + r> LOOP drop ;              | : >bezier  ( z1 .. zn n c -- z1 .. zc c )                         0 ?DO  >r  i $10000 i' 1- */ r@ zsum r@ 2-roll r>  LOOP         0 ?DO 2drop LOOP r> ;                                       \ GEM  : bezier >r >sc r> >bezier sc> pline ;   Onlyforth