\ Tests for Wil Baden's OPG Formula Translation in 4tH
\ Convert to 4tH code using OPGCONV.4th

true constant zenfloat? 

zenfloat? [IF] 
  include lib/zenfloat.4th 
  include lib/zenans.4th 
  include lib/fpin.4th 
  include lib/fpout.4th 
  include lib/fpconst.4th 
  include lib/zenfalog.4th 
  include lib/zenfsqrt.4th 
  include lib/zentrunc.4th
  include lib/zenfsinh.4th
  include lib/zenfasin.4th
  include lib/zenfmin.4th
[ELSE]
  include lib/ansfloat.4th
  include lib/fpin.4th 
  include lib/fpout.4th 
  include lib/falog.4th 
  include lib/ftrunc.4th 
  include lib/sinhcosh.4th
  include lib/asinacos.4th
  fclear    9 set-precision
[THEN] 

\ ============testing==================================================== 

  FLOAT array a   FLOAT array b   FLOAT array c 
  FLOAT array x   FLOAT array w 


  : TEST0   CR  LET b+c:  FE. 
            CR  LET b-c:  FE. 
            CR  LET 10000000*(b-c)/(b+c):  FE. 
                ; 

   LET b = 3: 
   LET c = 4: 

   cr ." test0  "  TEST0 cr 

\ =====================================================================       
  : TEST1   LET a = b*c-3.17e-5/TANH(w)+ABS(x):  CR  LET a: F. ;

   LET w = 1.e-3:  LET x = -2.5:  

   cr ." test1  " test1 cr   

\ ======================================================================      
    cr ." test2 "  cr

   FLOAT array HALFPI 
   LET HALFPI = 2*ATAN(1): 
   LET HALFPI + |FDUP|: F.  cr 

   FLOAT array disc                       ( Used for discriminant ) 

   : FQUADRATICROOT                          ( F: a b c -- r1 r2 ) 
       c F!  b F!  a F!                    \ Pickup coefficients. 
       LET disc = SQRT(b*b-4*a*c):            \ Set discriminant. 
       LET (-b+disc)/(2*a), (-b-disc)/(2*a): 
                                            \ Put values on f-stack. 
       ; 


      ( Solve x*x-3*x+2 )  LET FQUADRATICROOT (1,-3, 2) : F. F. cr 
      ( Find goldenratio ) LET MAX(FQUADRATICROOT (1,-1,-1)) : F. cr

      ( You can also write ) 
      1 s>f  -1 s>f  -1 s>f  FQUADRATICROOT FMAX F. cr 

 \ ======================================================================
   cr ." test3 " cr
    : FACTORIAL                       ( n -- )( F: -- r ) 
       LET w = 1:  LET x = 1: 
       0 ?DO  LET w = w * x:  LET x = x + 1:  LOOP 
       LET w: ; 

   6 FACTORIAL  F. cr

   ( Another way ) 
   : FACTORIAL2                       ( n -- )( F: -- r ) 
      LET w = 1:  0 ?DO  LET w = w * | I 1+ S>F |:  LOOP 
      LET w: ;  
   6 FACTORIAL2 F.  cr  

   ( Or you can do this ) 
   LET FACTORIAL2(|6|): F.  cr

  \ =============================================================== 
    cr ." test4 " cr

    let x=0.25:     
   : test4  ." Answer= " let w = 1/sqrt(2-x^2): ;

    test4 
    let w: f. cr

 \ =============done================================================     
