Квадратное уравнение в Clarion

   PROGRAM

OMIT('***')
 * User: Shur
 * Date: 28.02.2016
 * Time: 14:05
 ***
complex          GROUP,TYPE
a                       REAL(0)
b                       REAL(0)
                 END

  MAP
cxSum             PROCEDURE(*complex cxA, *complex cxB, *complex cxRes)
cxMul             PROCEDURE(*complex cxA, *complex cxB, *complex cxRes)
cxDiv             PROCEDURE(*complex cxA, *complex cxB, *complex cxRes)
  END

A REAL
B REAL
C REAL

X                   GROUP,PRE(X),DIM(2)
X                       LIKE(complex)
F                       CSTRING(64)
R                       LIKE(complex)
                     END

root               CSTRING(64)
check_               CSTRING(256)

CX1                   LIKE(complex)
CX2                   LIKE(complex)
CX3                   LIKE(complex)

   CODE
      A=1; B=3; C=3
      !A=1; B=-5; C=3
      !A=1; B=2; C=1
      D$ = B * B - 4 * A * C
      if A = 0
         root = 'Not a quadratic equation.'
      elsif D$ = 0
         X[1].X.a = -B/2/A
         root = 'x = ' & X[1].X.a
      elsif D$ > 0 then
         X[1].X.a = (-B-sqrt(D$))/2/A         
         X[2].X.a = (-B+sqrt(D$))/2/A         
         root = 'x1 = ' & X[1].X.a & '|' & |
                  'x2 = ' & X[2].X.a
      else   
         X[1].X.a = -B/2/A; X[1].X.b = sqrt(-D$)/2/A         
         X[2].X.a = -B/2/A; X[2].X.b = -sqrt(-D$)/2/A         
         root = 'x1 = (' & X[1].X.a & ', ' & X[1].X.b & ')' & '|' & | 
                'x2 = (' & X[2].X.a & ', ' & X[2].X.b & ')'
      end
      loop i# = 1 to 2 
         !loop j# = 1 to 2 
            if X[i#].X.a or X[i#].X.b
               if D$ ~< 0
                  X[i#].F = choose(A=0,'',A&'*'&X[i#].X.a&'^2')&choose(B=0,'',choose(B>0,'+','')&B&'*'&X[i#].X.a)&choose(C=0,'',choose(C>0,'+','')&C)
                  X[i#].R.a = round(EVALUATE(X[i#].F),0.0000000000001)
                  check_ = check_ & choose(check_<>'','|','') & X[i#].F&'=' & X[i#].R.a
               else   
                  CX1.a = X[i#].X.a; CX1.b = X[i#].X.b
                  CX2.a = A; CX2.b = 0
                  cxMul(CX1, CX1, CX3) ! x^2
                  cxMul(CX2, CX3, CX3) ! a*x^2
                  X[i#].R = CX3
                  CX2.a = B; CX2.b = 0
                  cxMul(CX1, CX2, CX3) ! b*x
                  CX2 = X[i#].R
                  cxSum(CX2,CX3,CX1) ! a*x^2 + b*x
                  X[i#].R = CX1
                  CX2.a = C; CX2.b = 0
                  cxSum(CX1,CX2,CX3) ! a*x^2 + b*x + c
                  X[i#].R = CX3
                  check_ = check_ & choose(check_<>'','|','') &'= (' & X[i#].R.a & ', ' & X[i#].R.b & ')'
               end   
            end   
         !end   
      end   
      message(choose(A=0,'','D='&D$&'|----------|')&|
         root&|
         choose(A=0,'',choose(check_>'',|
         '|----------|'&|
         check_,'')),'Quadratic equation')

cxSum            PROCEDURE(cxA, cxB, cxRes)
      CODE
         cxRes.a = cxA.a + cxB.a
         cxRes.b = cxA.b + cxB.b

cxMul            PROCEDURE(cxA, cxB, cxRes)
      CODE
         cxRes.a = cxA.a*cxB.a - cxA.b*cxB.b
         cxRes.b = cxA.a*cxB.b + cxB.a*cxA.b

cxDiv            PROCEDURE(cxA, cxB, cxRes)
      CODE
         cxRes.a = (cxA.a*cxB.a + cxA.b*cxB.b) / (cxB.a^2 + cxB.a^2)
         cxRes.b = (cxB.a*cxA.b - cxB.b*cxA.a) / (cxB.a^2 + cxB.a^2)