A circle with SINE and COSINE in the XFORTH

Graphics with XFORTH: PLOT, LINE, DRAW.

And a circle with SINE and COSINE.

HEX

00 VARIABLE DLIST -2 ALLOT
70 C, 70 C, 70 C,
4D C,  9060  ,
0D0D , 0D0D , 0D0D , 0D0D ,
0D0D , 0D0D , 0D0D , 0D0D ,
0D0D , 0D0D , 0D0D , 0D0D ,
0D0D , 0D0D , 0D0D , 0D0D ,
0D0D , 0D0D , 0D0D , 0D0D ,
0D0D , 0D0D , 0D0D , 0D0D ,
0D0D , 0D0D , 0D0D , 0D0D ,
0D0D , 0D0D , 0D0D , 0D0D ,
0D0D , 0D0D , 0D0D , 0D0D ,
0D0D , 0D0D , 0D0D ,  0D C,
42 C,  BF60  ,
0202 , 02 ,
41 C, DLIST ,

DECIMAL
00 VARIABLE SINUSTABELLE -2 ALLOT
0000 ,  0175 ,  0349 ,  0523 ,  0698 ,  0872 ,
1045 ,  1219 ,  1392 ,  1564 ,  1736 ,  1908 ,
2079 ,  2250 ,  2419 ,  2588 ,  2756 ,  2924 ,
3090 ,  3256 ,  3420 ,  3584 ,  3746 ,  3907 ,
4067 ,  4226 ,  4384 ,  4540 ,  4695 ,  4848 ,
5000 ,  5150 ,  5299 ,  5446 ,  5592 ,  5736 ,
5878 ,  6018 ,  6157 ,  6293 ,  6428 ,  6561 ,
6691 ,  6820 ,  6947 ,  7071 ,  7193 ,  7314 ,
7431 ,  7547 ,  7660 ,  7771 ,  7880 ,  7986 ,
8090 ,  8192 ,  8290 ,  8387 ,  8480 ,  8572 ,
8660 ,  8746 ,  8829 ,  8910 ,  8988 ,  9063 ,
9135 ,  9205 ,  9272 ,  9336 ,  9397 ,  9455 ,
9511 ,  9563 ,  9613 ,  9659 ,  9703 ,  9744 ,
9781 ,  9816 ,  9848 ,  9877 ,  9903 ,  9925 ,
9945 ,  9962 ,  9976 ,  9986 ,  9994 ,  9998 ,
10000 ,
HEX

230  CONSTANT SDLSTL
9060 CONSTANT SCREEN0
02C4 CONSTANT COLOR0
02C5 CONSTANT COLOR1
02C6 CONSTANT COLOR2
02C8 CONSTANT COLOR4

00 VARIABLE COL
00 VARIABLE CO0
00 VARIABLE CO1
00 VARIABLE CO2
00 VARIABLE CO3

00 VARIABLE X
00 VARIABLE Y
00 VARIABLE X0
00 VARIABLE Y0
00 VARIABLE X1
00 VARIABLE Y1
00 VARIABLE X2
00 VARIABLE Y2
00 VARIABLE DX
00 VARIABLE DY
00 VARIABLE SX
00 VARIABLE SY
00 VARIABLE ERR
00 VARIABLE E2
00 VARIABLE FAMIX
00 VARIABLE ZW

DECIMAL
: SINUS@ 2 * SINUSTABELLE + @ ;

: SIN ( GRAD -- SINUS )
   DUP 0< >R ABS
   360 MOD
   DUP 180 > IF 180 - -1 >R ELSE 0 >R THEN
   DUP  90 > IF 180 SWAP - THEN
   SINUS@
   R> IF -1 * THEN
   R> IF -1 * THEN ;

: COS 90 + SIN ;
HEX

: GCLS SCREEN0 C80 0 FILL ;

: COLOR
  DUP 0 = IF 0  CO0 !  0 CO1 ! 0 CO2 ! 0 CO3 ! THEN
  DUP 1 = IF 40 CO0 ! 10 CO1 ! 4 CO2 ! 1 CO3 ! THEN
  DUP 2 = IF 80 CO0 ! 20 CO1 ! 8 CO2 ! 2 CO3 ! THEN
	  3 = IF C0 CO0 ! 30 CO1 ! C CO2 ! 3 CO3 ! THEN ;

: PLOT
  SWAP 4 /MOD 2 PICK
  DUP 0 = IF CO0 @ COL ! THEN
  DUP 1 = IF CO1 @ COL ! THEN
  DUP 2 = IF CO2 @ COL ! THEN
	  3 = IF CO3 @ COL ! THEN
  FAMIX C@ 1 = IF SCREEN0 + SWAP DROP SWAP 28 * + DUP @  COL @ AND SWAP ! THEN
  FAMIX C@ 2 = IF SCREEN0 + SWAP DROP SWAP 28 * + DUP @  COL @ OR SWAP ! THEN
  FAMIX C@ 3 = IF SCREEN0 + SWAP DROP SWAP 28 * + DUP @  COL @ XOR SWAP ! THEN ;

: LINIE
  Y1 ! X1 ! Y0 ! X0 !
  X1 @ X2 ! Y1 @ Y2 !

  X1 @ X0 @ - ABS DX !

  X0 @ X1 @ <
  IF
    1 SX ! Y1 @ Y0 @ - ABS -1 * DY !
  ELSE
   -1 SX ! Y1 @ Y0 @ - ABS -1 * DY !
  THEN

  Y0 @ Y1 @ <
  IF
    1 SY ! DX @ DY @ + ERR !
  ELSE
    -1 SY ! DX @ DY @ + ERR !
  THEN

  X0 @ Y0 @ PLOT

  BEGIN
    X0 @  X1 @ = Y0 @ Y1 @ = AND 0 =
    WHILE
        2 ERR @ * E2 !
        E2 @ DY @ > IF ERR @ DY @ + ERR ! X0 @ SX @ + X0 ! THEN
        E2 @ DX @ < IF ERR @ DX @ + ERR ! Y0 @ SY @ + Y0 ! THEN
        X0 @ Y0 @ PLOT
    REPEAT ;

: DRAW
  Y1 ! X1 !
  X0 @ Y0 @ X1 @ Y1 @ LINIE ;

DECIMAL
: KREIS
  360 0 DO
    I SIN 32 10000 */ X !
    I COS 32 10000 */ Y !
    80 40 X @ 80 + Y @ 40 + LINIE
  10 +LOOP ;
HEX

: INIT
    0C COLOR4 C!
    94 COLOR2 C!
    DLIST SDLSTL !
    4 2BF C!
  2 COLOR
  2 FAMIX C! ;