\ ***************************************************************************
\ sine, cosine
\ ***************************************************************************
Host

: sin ( ufrac --- usin )           \ HART 3341  27 bit precision, pi/2 > frac >= 0, 1 = 2**(cell_width-2)
   [ &000151485 -&004673767 + &079689679 + -&645963711 + &1570796318 + 2* scale_factor ]
   dup >r  dup *. >r
   [  &000151485 scaled ] Literal   r@ *.
   [ -&004673767 scaled ] Literal + r@ *.
   [  &079689679 scaled ] Literal + r@ *.
   [ -&645963711 scaled ] Literal + r> *.
   [ &1570796318 scaled ] Literal + r> *.
;
&1570796327 float milli micro Constant fpi/2

: +fsin  ( r1 -- r2 )
   fpi/2 f/   int.frac >r
   r@ 1 and IF  invert  THEN  sin
   r> 2 and IF  negate  THEN
   [ data_width 2 - negate ] Literal >float
;
: fsin  ( r -- r' )  dup f0< IF  fnegate +fsin fnegate  EXIT THEN  +fsin ;

: fcos  ( r -- r' )  fpi/2 f+ fsin ;

: degree ( fdeg -- frad )   [ fpi/2 &90 float f/ ] Literal f* ;

Target

: sin ( ufrac --- usin )           \ HART 3341  27 bit precision, pi/2 > frac >= 0, 1 = 2**(cell_width-2)
   [ &000151485 -&004673767 + &079689679 + -&645963711 + &1570796318 + 2* scale_factor ]
   dup >r  dup *. >r
   [  &000151485 scaled ] Literal   r@ *.
   [ -&004673767 scaled ] Literal + r@ *.
   [  &079689679 scaled ] Literal + r@ *.
   [ -&645963711 scaled ] Literal + r> *.
   [ &1570796318 scaled ] Literal + r> *.
;
&1570796327 float milli micro Constant fpi/2

: +fsin  ( r1 -- r2 )
   fpi/2 f/   int.frac >r
   r@ 1 and IF  invert  THEN  sin
   r> 2 and IF  negate  THEN
   [ data_width 2 - negate ] Literal >float
;
: fsin  ( r -- r' )  dup f0< IF  fnegate +fsin fnegate  EXIT THEN  +fsin ;

: fcos  ( r -- r' )  fpi/2 f+ fsin ;

: degree ( fdeg -- frad )   [ fpi/2 &90 float f/ ] Literal f* ;

Host: degree ( r1 -- r2 ) dbg? IF  t> degree >t  EXIT THEN  exec? IF  degree  EXIT THEN  T degree H ; immediate
Host: fsin   ( r1 -- r2 ) dbg? IF  t> fsin   >t  EXIT THEN  exec? IF  fsin    EXIT THEN  T fsin   H ; immediate
Host: fcos   ( r1 -- r2 ) dbg? IF  t> fcos   >t  EXIT THEN  exec? IF  fcos    EXIT THEN  T fcos   H ; immediate

\\ Test words

$80000000                Constant pi/4     \   &1570796327 scaled
&0707106781 scaled       Constant sqr2/2
$3FFFFFFFFFFFFFFF. &1570796327 um/mod nip Constant trig_pi

: radian  ( n1 -- n2 )   trig_pi *. 2* ;

: sinus   -1 0 DO cr i dup &11 u.r sin &11 u.r $2000000 +LOOP cr -1 dup &11 u.r sin &11 u.r
   cr pi/4 sin &11 u.r sqr2/2 &11 u.r ;

: cos     ( u1 -- u2 )  invert sin ;

: cosinus   -1 0 DO cr i dup &11 u.r cos &11 u.r $2000000 +LOOP cr -1 dup &11 u.r cos &11 u.r
   cr pi/4 cos &11 u.r sqr2/2 &11 u.r ;

fpi/2 f2/ f2/ Constant fpi/8

: sintest   ( r u -- )   fpi/2 -4 float f* &40 0
   DO  cr dup kilo integer &11 .r dup fsin kilo integer &11 .r  dup fcos kilo integer &11 .r fpi/8 f+ LOOP drop
;
: degtest   ( r u -- )  -&360 float &40 0
   DO  cr dup integer &11 .r dup degree fsin kilo integer &11 .r &22500 float milli f+ LOOP drop ;

Target