\ Ulam-Spirale drucken.
decimal
only forth 
vocabulary ulam  
also forth ulam definitions

\ use odd number to get a center cell 
15 constant xmax
15 constant ymax 

here xmax ymax * cells allot here swap constant feld constant feldende

: feldadr  ( x y - adr )
  xmax * cells swap cells + feld + ;  \ ok mka

: .feld ( -- ) \ test adr of array
  ymax 0 DO cr
   xmax 0 DO
    i j feldadr .
   loop
  loop cr ;

: .feld@ ( -- ) \ test content of array
  ymax 0 DO cr
   xmax 0 DO
    i j feldadr @ 5 .r
   loop
  loop cr ;

: feld!  ( n x y -- )
  feldadr ! ;

: feld@  ( x y -- n )
  feldadr @ ;

: center-adr ( -- adr ) \ center position of ulam spirale
  xmax 2/ ymax 2/ feldadr ; \ ok mka

: center ( -- x y )
  xmax 2/ ymax 2/ ;


variable x
variable y   

variable xR
variable xL

variable yO
variable yU

variable richtung  \ 0=right, 1=up, 2=left, 3=down

: init-xy ( -- )
  0 richtung !
  center y ! x !
  x @ dup xR ! xL !
  y @ dup yO ! yU !  ;

: ..xy ( -- )
  cr ." x  " x @ .
  cr ." y  " y @ .
  cr ." richtung=" richtung @ .
  cr ." xR " xR @ .
  cr ." xL " xL @ .
  cr ." yO " yO @ .
  cr ." yU " yU @ . ;

: x+ ( -- )   1 x +! x @ xR @ > IF x @ xR ! 1 richtung ! THEN ;
: x- ( -- )  -1 x +! x @ xL @ < IF x @ xL ! 3 richtung ! THEN ;
: y+ ( -- )   1 y +! y @ yO @ > IF y @ yO ! 2 richtung ! THEN ;
: y- ( -- )  -1 y +! y @ yU @ < IF y @ yU ! 0 richtung ! THEN ;

: ulam+ ( -- )
  richtung @  0 = IF x+ exit then 
  richtung @  1 = IF y+ exit then 
  richtung @  2 = IF x- exit then 
  richtung @  3 = IF y- exit then 
  abort" richtung unmoeglich" ;

init-xy

: ..  ulam+ ..xy ; \ test

: ulam ( -- )
  xmax ymax * 0 DO 
   i 1+ x @ y @ feldadr ! ulam+  \ array fuellen
  loop 
  .feld@ ; \ array drucken

words

\ finis