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