\\              *** 3D Vektorgraphic ***               18jan92py                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                \ Loadscreen                                           31may97py                                                                Onlyforth                                                                                                                       \needs float ' Import catch float [IF] include float.scr [THEN]                                                                 float also                                                                                                                      Module Vectors                                                                                                                  -->                                                                                                                                                                                                                                                                                                                                                                                             \ Basics                                               31may97py: vec+  3 floats + ;                                            : vecs  dup dup + + floats ;                                    : vector  Create  1 vecs allot ;                                : v!   ( v addr -- )                                              >r r@ f!  r@ float+ f!  r> float+ float+ f! ;                 : v@   ( addr -- v )                                              >r r@ float+ float+ f@  r@ float+ f@  r> f@ ;                 | Create temp  2 vecs allot     \ vector's tos&next register      DOES>  swap floats + ;                                        | : temp!  0 temp v! 3 temp v! ;                                : vswap ( v1 v2 -- v2 v1 )  temp! 0 temp v@ 3 temp v@ ;         : vpick 3 * 2+ 2 FOR >r r@ fpick r> NEXT drop ;                 : vdup ( v -- v v )  2 fpick 2 fpick 2 fpick ;                  : vdrop ( v -- )  fdrop fdrop fdrop ;                                                                           -->             \ arithmetics                                          12jul98py: v+  temp! 2 FOR  i@ temp f@ i@ 3+ temp f@ f+  NEXT ;          : v-  temp! 2 FOR  i@ temp f@ i@ 3+ temp f@ f-  NEXT ;          : vdot ( v1 v2 -- f ) temp!                                       2 FOR  i@ temp f@ i@ 3+ temp f@ f*  NEXT  f+ f+ ;             : vabs ( v -- f )  f**2 fswap f**2 f+ fswap f**2 f+ fsqrt ;     : vscale ( v1 f -- v2 )  f>r 0 temp v!                            2 temp f@ fr@ f* 1 temp f@ fr@ f* 0 temp f@ fr> f* ;          : vnorm ( v -- e ) vdup vabs 1/f vscale ;                       : vcross ( v1 v2 -- v3 ) temp!  \ Rechtssystem                    0 temp f@ 4 temp f@ f*  1 temp f@ 3 temp f@ f* f- ( x3)         2 temp f@ 3 temp f@ f*  0 temp f@ 5 temp f@ f* f- ( x2)         1 temp f@ 5 temp f@ f*  2 temp f@ 4 temp f@ f* f- ( x1) ;     : v. fswap frot Ascii ( emit f. curleft Ascii , emit f. curleft   Ascii , emit f. curleft Ascii ) emit space ;                                                                  -->             \ 3d nach 2d Kalkulation                               31may97py                                                                vector o        vector eye      vector x        vector y        !0 !0 !0 o v!   !0 !0 !1 eye v! !0 !1 !0 x v!   !-1 !0 !0 y v!  | vector tmp                                                                                                                    : 3d>2d ( v -- x y t / f ) o v@ vswap v- tmp v!  \ --> b          eye v@ tmp v@ vdot fdup f0<                    \ --> b a ab f   IF  fdrop false exit  THEN                                      1/f f>r eye v@ tmp v@ fr> vscale vcross     \ --> (a x b)/(ab)  vdup tmp v! x v@ vdot  tmp v@ y v@ vdot  true ;               \ gives 25 mm if film between -1 and 1                          \ scaling necessary                                             : vdepth fdepth 3 / ;                                           : v.s vdepth 0 ?DO  i vpick v.  LOOP ;                          Module;