home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / pascal / shdk_1.zip / TESTCMPX.PAS < prev    next >
Pascal/Delphi Source File  |  1992-03-25  |  5KB  |  170 lines
  1. {$N+,E+}
  2. program TestCmpx;
  3. {
  4.                         To test the ShCmplx unit
  5.  
  6.                   Copyright 1991 Madison & Associates
  7.                           All Rights Reserved
  8.  
  9.          This program source file and the associated executable
  10.          file may be  used and distributed  only in  accordance
  11.          with the  provisions  described  on  the title page of
  12.                   the accompanying documentation file
  13.                               SKYHAWK.DOC
  14. }
  15.  
  16. uses
  17.   TpString,
  18.   TpDos,
  19.   TpCrt,
  20.   ShCmplx;
  21.  
  22. var
  23.   A,
  24.   B,
  25.   C,
  26.   D   : Complex;
  27.   T1  : integer;
  28.   OT  : text;
  29.   LB  : string;               {Line Buffer}
  30.   BP  : byte;                 {Buffer pointer}
  31.   Arad: ComplexElement;
  32.  
  33. procedure AnyKey;
  34.   begin
  35.     if HandleIsConsole(1) then begin
  36.       Write(OT, 'Any key to continue...');
  37.       if ReadKey = #0 then ;
  38.       WriteLn(OT);
  39.       end;
  40.     end;
  41.  
  42. procedure InitLB;
  43.   begin {InitLB}
  44.     FillChar(LB,SizeOf(LB),' ');
  45.     LB[0] := char($FF);
  46.     BP := 1;
  47.     end; {InitLB}
  48.  
  49. begin
  50.   if not OpenStdDev(OT, 1) then begin
  51.     WriteLn('Can''t open console device.');
  52.     Halt(1);
  53.     end;
  54.   New(A); New(B); New(C); New(D);
  55.   A^.Re := 5.0; A^.Im := 12.0;
  56.   WriteLn(OT);
  57.   WriteLn(OT, Center('BASIC FUNCTION TEST',75));
  58.   WriteLn(OT);
  59.   WriteLn
  60.     (OT, 'The complex conjugate of ' + Cmp2Str(A,0,2) + ' is ' +
  61.       Cmp2Str(CConjF(A),0,2));
  62.   WriteLn
  63.     (OT, 'The absolute value of ' + Cmp2Str(A,0,2) + ' is ' +
  64.       Real2Str(CAbsF(A),0,4));
  65.   WriteLn
  66.     (OT, Center('or, living life the hard way (see source code), is', 75));
  67.   WriteLn
  68.     (OT, Center(CmpP2Str(CpPwrRF(C2PF(CMulF(A, CConjF(A))), 0.5), 0, 4), 75));
  69.   WriteLn(OT);
  70.   B^.Re := 7.5; B^.Im := 6.25;
  71.   WriteLn
  72.     (OT, Cmp2Str(A,0,2) + ' + ' + Cmp2Str(B,0,2) + ' = ' +
  73.       Cmp2Str(CAddF(A, B),0,4));
  74.   WriteLn
  75.     (OT, Cmp2Str(A,0,2) + ' - ' + Cmp2Str(B,0,2) + ' = ' +
  76.       Cmp2Str(CSubF(A, B),0,4));
  77.   WriteLn
  78.     (OT, Cmp2Str(A,0,2) + ' * ' + Cmp2Str(B,0,2) + ' = ' +
  79.       Cmp2Str(CMulF(A, B),0,4));
  80.   WriteLn
  81.     (OT, Cmp2Str(A,0,2) + ' / ' + Cmp2Str(B,0,2) + ' = ' +
  82.       Cmp2Str(CDivF(A, B),0,4));
  83.   C^.Re := 5.0; C^.Im :=  2.0;
  84.   D^.Re := 3.0; D^.Im := -4.0;
  85.   WriteLn
  86.     (OT, Cmp2Str(C,0,2) + ' / ' + Cmp2Str(D,0,2) + ' = ' +
  87.       Cmp2Str(CDivF(C, D),0,4));
  88.   AnyKey;
  89.   WriteLn(OT);
  90.  
  91.   WriteLn(OT, Center('NESTED CALLS AND INVERSE FUNCTIONS TEST',75));
  92.   WriteLn(OT);
  93.   WriteLn
  94.     (OT, Cmp2Str(A,0,2) + ' + ' + Cmp2Str(B,0,2) + ' + ' +
  95.      Cmp2Str(C,0,2) + ' + ' + Cmp2Str(D,0,2) + ' = ');
  96.   WriteLn
  97.     (OT, '':10, Cmp2Str(CAddF(A, CAddF(B, CAddF(C, D))),0,2));
  98.   WriteLn
  99.     (OT, Cmp2Str(A,0,2) + ' / ' + Cmp2Str(B,0,2) + ' * ' + Cmp2Str(B,0,2) +
  100.      ' = ' + Cmp2Str(CMulF(CDivF(A, B), B), 0, 2));
  101.   WriteLn
  102.     (OT, Cmp2Str(A,0,2) + ' + ' + Cmp2Str(B,0,2) + ' - ' + Cmp2Str(B,0,2) +
  103.      ' = ' + Cmp2Str(CAddF(CSubF(A, B), B), 0, 2));
  104.   AnyKey;
  105.   WriteLn(OT);
  106.  
  107.   WriteLn(OT, Center('COORDINATE SYSTEM TRANSFORMATION TEST',75));
  108.   WriteLn(OT);
  109.   A^.Re := sqrt(3.0)*0.5; A^.Im := 0.5; {FIRST QUADRANT}
  110.   C2P(A, B);
  111.   WriteLn(OT, Cmp2Str(A,0,2),' is ',CmpP2StrD(B,0,2));
  112.   A^.Re := -sqrt(3.0)*0.5; A^.Im := 0.5; {SECOND QUADRANT}
  113.   C2P(A, B);
  114.   WriteLn(OT, Cmp2Str(A,0,2),' is ',CmpP2StrD(B,0,2));
  115.   A^.Re := -sqrt(3.0)*0.5; A^.Im := -0.5; {THIRD QUADRANT}
  116.   C2P(A, B);
  117.   WriteLn(OT, Cmp2Str(A,0,2),' is ',CmpP2StrD(B,0,2));
  118.   A^.Re := sqrt(3.0)*0.5; A^.Im := -0.5; {FOURTH QUADRANT}
  119.   C2P(A, B);
  120.   WriteLn(OT, Cmp2Str(A,0,2),' is ',CmpP2StrD(B,0,2));
  121.   WriteLn(OT);
  122.  
  123.   A^.Re := 1.0;
  124.   InitLB;
  125.   for T1 := 0 to 36 do begin
  126.     A^.Im := 10.0 * T1 * Pi / 180.0;
  127.     C := C2PF(P2CF(A));
  128.     Insert(CmpP2StrD(C,0,2), LB, BP);
  129.     if (T1 mod 4) = 0 then begin
  130.       WriteLn(OT, TrimTrail(LB));
  131.       InitLB;
  132.       end
  133.     else
  134.     BP := 20*(T1 mod 4);
  135.     end;
  136.   AnyKey;
  137.   WriteLn(OT);
  138.  
  139.   WriteLn(OT, Center('POWER TEST',75));
  140.   WriteLn(OT);
  141.   A^.Re := 8.0; A^.Im := 0.0; Arad := 1.0/3.0;
  142.   WriteLn(OT, CmpP2StrD(A,0,4),' ^ ',Arad);
  143.   WriteLn(OT, CmpP2Str(A,0,4),' ^ ',Arad);
  144.   for T1 := 0 to 3 do begin
  145.     B^ := CpPwrRF(A, Arad)^;
  146.     while B^.Im >= 2.0*Pi do B^.Im := B^.Im - 2.0*Pi;
  147.     InitLB;
  148.     Insert(CmpP2StrD(B,0,4), LB, 1);
  149.     Insert('is '+ Cmp2Str(P2CF(B),0,4), LB, 25);
  150.     Insert('is '+ CmpP2Str(B,0,4), LB, 50);
  151.     WriteLn(OT, TrimTrail(LB));
  152.     A^.Im := A^.Im + 2.0*Pi;
  153.     end;
  154.   WriteLn(OT);
  155.   A^.Re := 125.0; A^.Im := 15.0*Pi/180.0;
  156.   WriteLn(OT, CmpP2StrD(A,0,4),' ^ ',Arad);
  157.   WriteLn(OT, CmpP2Str(A,0,4),' ^ ',Arad);
  158.   for T1 := 0 to 3 do begin
  159.     B^ := CpPwrRF(A, Arad)^;
  160.     while B^.Im >= 2.0*Pi do B^.Im := B^.Im - 2.0*Pi;
  161.     InitLB;
  162.     Insert(CmpP2StrD(B,0,4), LB, 1);
  163.     Insert('is '+ Cmp2Str(P2CF(B),0,4), LB, 25);
  164.     Insert('is '+ CmpP2Str(B,0,4), LB, 50);
  165.     WriteLn(OT, TrimTrail(LB));
  166.     A^.Im := A^.Im + 2.0*Pi;
  167.     end;
  168.   Flush(OT);
  169.   end.
  170.