       ͻ
        Lesson 5 Part 200  F-PC 3.5 Tutorial by Jack Brown 
       ͼ


This a sample application using some of the floating point input
and output operators.  It by no means exercises all of the options.

\ Quadratic Equation solver.
\ Requires VP-Planner Floating Point package VPSFP101.ZIP
\ and JB#EDIT.SEQ from the preceding 4 messages or download
\ JB#EDIT.ZIP from BCFB

   FLOATING
   FVARIABLE A
   FVARIABLE B
   FVARIABLE C

0. FVALUE ROOT1
0. FVALUE ROOT2
0. FVALUE REAL_PART
0. FVALUE IMAG_PART
0. FVALUE B^2-4AC

: GET_DATA ( -- )
       CLS  20 2 AT ." Quadratic Equation Solver "
       0. A F! 0. B F! 0. C F!
       0 4 AT ." Input value of A : " A 20 4 10 XYWF#ED
       0 6 AT ." Input value of B : " B 20 6 10 XYWF#ED
       0 8 AT ." Input value of C : " C 20 8 10 XYWF#ED  ;

\ Compute B^2 - 4AC save as fvalue  B^2-4AC and
\ leave true flag if it is negative
: NEGATIVE_DISCRIMINANT? ( -- flag )
       B F@ FDUP F*  4.0 A F@ C F@ F* F* F-
       FDUP F!> B^2-4AC F0< ;

: REAL1  ( -- )
      B F@ FNEGATE  B^2-4AC FSQRT F-
      2. A F@ F* F/  F!> ROOT1         ;

: REAL2  ( -- )
      B F@ FNEGATE  B^2-4AC FSQRT F+
      2. A F@ F* F/  F!> ROOT2         ;

: REAL_ROOTS ( -- )
      REAL1  REAL2
      20 10 AT ." Real Roots "
      10 12 AT ." Root 1 : "
      ROOT1 ..
      10 14 AT ." Root 2 : "
      ROOT2 ..  ;

: COMPLEX ( -- )
      B F@ FNEGATE
      2. A F@ F* F/  F!> REAL_PART
      B^2-4AC FNEGATE FSQRT
      2. A F@ F* F/  F!> IMAG_PART ;

: COMPLEX_ROOTS
      COMPLEX
      20 10 AT ." Complex Roots "
      10 12 AT ." Root 1 : "
      REAL_PART .. ."  +  " IMAG_PART .. ."  j"
      10 14 AT ." Root 2 : "
      REAL_PART .. ."  -  " IMAG_PART .. ."  j"  ;

HEX
: QUAD ( -- )
       BEGIN   GET_DATA
               NEGATIVE_DISCRIMINANT?
               IF    COMPLEX_ROOTS
               ELSE  REAL_ROOTS
               THEN
       10 16 AT
       ." Would you like to solve another quadratic? Y/N "
       KEY  0DF AND ASCII Y <>
       UNTIL                     ;

 DECIMAL


