COMPLEXC.PAS 3.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116
  1. PROGRAM Complex_Calc;
  2. (* Program to simulate a four-function complex calculator *)
  3. TYPE Complex = RECORD
  4. Rel, (* Real part *)
  5. Imag (* Imaginary part *) : REAL;
  6. END;
  7. VAR C1, C2, C3 : Complex;
  8. Correct : BOOLEAN;
  9. Operation, Dummy : CHAR;
  10. PROCEDURE Add_Complex(C1, C2 : Complex; (* input *)
  11. VAR Result : Complex (* output *));
  12. (* Procedure to add two complex numbers *)
  13. BEGIN
  14. Result.Rel := C1.Rel + C2.Rel;
  15. Result.Imag := C1.Imag + C2.Imag
  16. END;
  17. PROCEDURE Subt_Complex(C1, C2 : Complex; (* input *)
  18. VAR Result : Complex (* output *));
  19. (* Procedure to subtract two complex numbers *)
  20. BEGIN
  21. Result.Rel := C1.Rel - C2.Rel;
  22. Result.Imag := C1.Imag - C2.Imag
  23. END;
  24. PROCEDURE Mult_Complex(C1, C2 : Complex; (* input *)
  25. VAR Result : Complex (* output *));
  26. (* Procedure to multiply two complex numbers *)
  27. BEGIN
  28. Result.Rel := C1.Rel * C2.Rel - C1.Imag * C2.Imag;
  29. Result.Imag := C1.Rel * C2.Imag + C2.Rel * C1.Imag
  30. END;
  31. FUNCTION Div_Complex(C1, C2 : Complex; (* input *)
  32. VAR Result : Complex (* output *)) : BOOLEAN;
  33. (* Function to divide two complex numbers and return TRUE *)
  34. (* if operation is successful, FALSE for division by zero *)
  35. VAR OK : BOOLEAN;
  36. SumSqr : REAL;
  37. BEGIN
  38. IF (C2.Rel <> 0) OR (C2.Imag <> 0)
  39. THEN BEGIN
  40. OK := TRUE;
  41. SumSqr := SQR(C2.Rel) + SQR(C2.Imag);
  42. Result.Rel := (C1.Rel * C2.Rel + C1.Imag * C2.Imag)
  43. / SumSqr;
  44. Result.Imag := (C2.Rel * C1.Imag - C1.Rel * C2.Imag)
  45. / SumSqr
  46. END
  47. ELSE
  48. OK := FALSE;
  49. Div_Complex := OK;
  50. END;
  51. PROCEDURE Read_Complex(VAR C : Complex (* output *));
  52. (* Procedure to read complex number *)
  53. BEGIN
  54. WRITE('Enter real part '); READLN(C.Rel);
  55. WRITE('Enter imaginary part '); READLN(C.Imag);
  56. WRITELN;
  57. END;
  58. PROCEDURE Write_Complex(C : Complex (* input *));
  59. (* Procedure to output a complex number *)
  60. BEGIN
  61. WRITELN('Complex number = ',C.Rel,' + i ',C.Imag)
  62. END;
  63. BEGIN (*------------- MAIN --------------*)
  64. REPEAT
  65. ClrScr;
  66. WRITE('Enter operation [Q = quit] ');
  67. READLN(Operation); WRITELN;
  68. Operation := UpCase(Operation);
  69. IF Operation <> 'Q'
  70. THEN BEGIN
  71. WRITELN('Enter first complex number');
  72. Read_Complex(C1);
  73. WRITELN('Enter second complex number');
  74. Read_Complex(C2); WRITELN;
  75. Correct := TRUE;
  76. CASE Operation OF
  77. '+' : Add_Complex(C1, C2, C3);
  78. '-' : Subt_Complex(C1, C2, C3);
  79. '*' : Mult_Complex(C1, C2, C3);
  80. '/' : BEGIN
  81. Correct := Div_Complex(C1, C2, C3);
  82. IF NOT Correct
  83. THEN WRITELN('Divide by zero error ');
  84. END
  85. ELSE Add_Complex(C1, C2, C3);
  86. END;
  87. IF Correct THEN Write_Complex(C3);
  88. WRITELN; WRITELN;
  89. WRITE('Press <CR> to continue ');
  90. READLN(Dummy); WRITELN; WRITELN;
  91. END;
  92. UNTIL Operation = 'Q';
  93. END.
  94.