home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tmtp100o.zip / EXAMPLES / COMP / COMP.PAS
Encoding:
Pascal/Delphi Source File  |  1997-01-05  |  4.7 KB  |  152 lines
  1. UNIT Comp;
  2.  
  3. INTERFACE
  4.  
  5.     TYPE CReal = Extended;
  6.  
  7.     TYPE Complex = RECORD re, im: CReal END;
  8.  
  9.     FUNCTION Compl_RR (CONST re, im: CReal): Complex;
  10.     FUNCTION Compl_R  (CONST re    : CReal): Complex;
  11.     OVERLOAD Complex = Compl_RR;
  12.     OVERLOAD Complex = Compl_R ;
  13.     FUNCTION Conj  (CONST z: Complex): Complex;
  14.  
  15.     FUNCTION add_cc (CONST a: Complex; CONST b: Complex): Complex; OVERLOAD +  = add_cc;
  16.     FUNCTION add_cr (CONST a: Complex; CONST b: CReal  ): Complex; OVERLOAD +  = add_cr;
  17.     FUNCTION add_rc (CONST a: CReal  ; CONST b: Complex): Complex; OVERLOAD +  = add_rc;
  18.     FUNCTION sub_cc (CONST a: Complex; CONST b: Complex): Complex; OVERLOAD -  = sub_cc;
  19.     FUNCTION sub_cr (CONST a: Complex; CONST b: CReal  ): Complex; OVERLOAD -  = sub_cr;
  20.     FUNCTION sub_rc (CONST a: CReal  ; CONST b: Complex): Complex; OVERLOAD -  = sub_rc;
  21.     FUNCTION mul_cc (CONST a: Complex; CONST b: Complex): Complex; OVERLOAD *  = mul_cc;
  22.     FUNCTION mul_cr (CONST a: Complex; CONST b: CReal  ): Complex; OVERLOAD *  = mul_cr;
  23.     FUNCTION mul_rc (CONST a: CReal  ; CONST b: Complex): Complex; OVERLOAD *  = mul_rc;
  24.  
  25.     PROCEDURE addab_cc (VAR a: Complex; CONST b: Complex); OVERLOAD +:=  = addab_cc;
  26.     PROCEDURE addab_cr (VAR a: Complex; CONST b: CReal  ); OVERLOAD +:=  = addab_cr;
  27.     PROCEDURE subab_cc (VAR a: Complex; CONST b: Complex); OVERLOAD -:=  = subab_cc;
  28.     PROCEDURE subab_cr (VAR a: Complex; CONST b: CReal  ); OVERLOAD -:=  = subab_cr;
  29.     PROCEDURE mulab_cc (VAR a: Complex; CONST b: Complex); OVERLOAD *:=  = mulab_cc;
  30.     PROCEDURE mulab_cr (VAR a: Complex; CONST b: CReal  ); OVERLOAD *:=  = mulab_cr;
  31.  
  32.     FUNCTION  eq_cc (CONST a: Complex; CONST b: Complex): Boolean; OVERLOAD =  =  eq_cc;
  33.     FUNCTION  eq_cr (CONST a: Complex; CONST b: CReal  ): Boolean; OVERLOAD =  =  eq_cr;
  34.     FUNCTION  eq_rc (CONST a: CReal  ; CONST b: Complex): Boolean; OVERLOAD =  =  eq_rc;
  35.     FUNCTION  ne_cc (CONST a: Complex; CONST b: Complex): Boolean; OVERLOAD <> =  ne_cc;
  36.     FUNCTION  ne_cr (CONST a: Complex; CONST b: CReal  ): Boolean; OVERLOAD <> =  ne_cr;
  37.     FUNCTION  ne_rc (CONST a: CReal  ; CONST b: Complex): Boolean; OVERLOAD <> =  ne_rc;
  38.  
  39. IMPLEMENTATION
  40.  
  41.     FUNCTION Compl_RR;
  42.         BEGIN
  43.             result.re := re;
  44.             result.im := im
  45.         END;
  46.         
  47.  
  48.     FUNCTION Compl_R;
  49.         BEGIN
  50.             result.re := re;
  51.             result.im := 0
  52.         END;
  53.         
  54.     FUNCTION Conj;
  55.         WITH result DO BEGIN
  56.             re := z.re;
  57.             im :=-z.im
  58.         END;
  59.  
  60.     FUNCTION add_cc;
  61.         WITH result DO BEGIN
  62.             re := b.re + a.re;
  63.             im := a.im + b.im
  64.         END;
  65.  
  66.     FUNCTION add_cr;
  67.         WITH result DO BEGIN
  68.             re := b + a.re;
  69.             im :=     a.im;
  70.         END;
  71.  
  72.     FUNCTION add_rc;
  73.         WITH result DO BEGIN
  74.             re := a + b.re;
  75.             im :=     b.im;
  76.         END;
  77.  
  78.     FUNCTION sub_cc;
  79.         WITH result DO BEGIN
  80.             re := a.re - b.re;
  81.             im := a.im - b.im
  82.         END;
  83.  
  84.     FUNCTION sub_cr;
  85.         WITH result DO BEGIN
  86.             re := a.re - b;
  87.             im := a.im;
  88.         END;
  89.  
  90.     FUNCTION sub_rc;
  91.         WITH result DO BEGIN
  92.             re := a - b.re;
  93.             im :=   - b.im;
  94.         END;
  95.  
  96.     FUNCTION mul_cc;
  97.         WITH result DO BEGIN
  98.             re := a.re*b.re - a.im*b.im;
  99.             im := a.re*b.im + a.im*b.re
  100.         END;
  101.  
  102.     FUNCTION mul_cr;
  103.         WITH result DO BEGIN
  104.             re := b * a.re;
  105.             im := b * a.im;
  106.         END;
  107.  
  108.     FUNCTION mul_rc;
  109.         WITH result DO BEGIN
  110.             re := a * b.re;
  111.             im := a * b.im;
  112.         END;
  113.  
  114.  
  115.     PROCEDURE addab_cc;
  116.         WITH a DO BEGIN
  117.             re +:= b.re;
  118.             im +:= b.im
  119.         END;
  120.  
  121.     PROCEDURE addab_cr; a.re +:= b;
  122.  
  123.     PROCEDURE subab_cc;
  124.         WITH a DO BEGIN
  125.             re -:= b.re;
  126.             im -:= b.im
  127.         END;
  128.  
  129.     PROCEDURE subab_cr; a.re -:= b;
  130.  
  131.     PROCEDURE mulab_cc;
  132.         VAR c: Complex;
  133.         WITH c DO BEGIN
  134.             re := a.re*b.re - a.im*b.im;
  135.             im := a.re*b.im + a.im*b.re;
  136.             a := c
  137.         END;
  138.  
  139.     PROCEDURE mulab_cr;
  140.         WITH a DO BEGIN
  141.             re *:= b;
  142.             im *:= b;
  143.         END;
  144.  
  145.     FUNCTION eq_cc; result := (a.re  = b.re) AND (a.im =  b.im);
  146.     FUNCTION eq_cr; result := (a.re  = b   ) AND (a.im =     0);
  147.     FUNCTION eq_rc; result := (a     = b.re) AND (b.im =     0);
  148.     FUNCTION ne_cc; result := (a.re <> b.re) OR  (a.im <> b.im);
  149.     FUNCTION ne_cr; result := (a.re <> b   ) OR  (a.im <>    0);
  150.     FUNCTION ne_rc; result := (a    <> b.re) OR  (b.im <>    0);
  151.  
  152. END.