home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / tech / eepub15 / smith4.pas < prev    next >
Pascal/Delphi Source File  |  1987-07-06  |  14KB  |  627 lines
  1.  
  2. PROGRAM Smith3;
  3. (*$I GRAPH.P*)
  4. (*$Iploader.inc*)
  5. LABEL
  6.    ReDo, start;
  7.  
  8. CONST
  9.    CenterX:integer = 219;
  10.    CenterY:integer = 100;
  11.    IncX   :real    = 2E-2;
  12.    IncB   :real    = 2E-2;
  13.    IncRho :real    = 3.4906556E-2;
  14.  
  15. VAR
  16.    Done:boolean;
  17.    Z0,R,X,B,G,Xn,Rn,Gn,Bn,RhoRealReal,RhoImagReal,Rho,RhoW         :Real;
  18.    Psi,Theta,DeltaX,DeltaB,DeltaZRho,DeltaYRho,XW,RW,BW,GW         :Real;
  19.    RhoMagReal,RhoAngReal,PsiW,VSWR,XincReal,BincReal,RhoIncReal    :Real;
  20.    Xplot,Yplot,RhoReal,RhoImag,M,N,Index                           :Integer;
  21.    Ch                                                              :Char;
  22.    RhoStr,PsiStr,XStr,RStr,BStr,Z0Str,GStr,VSWRStr,XincStr,BincStr :String[10];
  23.    RhoIncStr,MStr                                                  :String[10];
  24.    DataLabel : Array [1..10] Of String[10];
  25.    DataValue : Array [1..10] Of String[10];
  26.  
  27. PROCEDURE CalcZfromRho;forward;
  28. PROCEDURE CalcYfromRho;forward;
  29. PROCEDURE CalcPolarRho;forward;
  30. PROCEDURE CalcVSWR;    forward;
  31. PROCEDURE Background;  forward;
  32.  
  33. PROCEDURE Title;
  34.  
  35. BEGIN
  36.    ClrScr;
  37.    Ploader('TITLE');
  38.    TextColor(7); TextBackground(0);
  39.    Read(Kbd,Ch);
  40. END;
  41.  
  42. PROCEDURE Help;
  43. BEGIN
  44.    GotoXY(1,1);ClrEol;
  45.    write(chr(255),chr(255),'HELP/');
  46.    TextColor(7); TextBackground(0);
  47.    Read(Kbd,Ch);
  48. END;
  49.  
  50. PROCEDURE NewWrite;
  51. BEGIN
  52.    CalcZfromRho;
  53.    CalcYfromRho;
  54.    CalcPolarRho;
  55.    XW := Z0 * Xn;   RW := Z0 * Rn;   BW := Bn / Z0;   GW := Gn / Z0;
  56.    GoToXY(4,2);   Write('X Ohm      ');
  57.    TextColor(1);
  58.    GoToXY(4,4);   Write('R Ohm      ');
  59.    TextColor(3);
  60.    Str(XW:5:3,XStr);
  61.    GoToXY(4,3);   Write(XStr,'      ');
  62.    Str(RW:5:3,RStr);
  63.    TextColor(1);
  64.    GoToXY(4,5);   Write(RStr,'      ');
  65.    TextColor(2);
  66.    GoToXY(4,6);   Write('B mhO      ');
  67.    TextColor(3);
  68.    GoToXY(4,8);   Write('G mhO      ');
  69.    Str(BW:5:3,BStr);
  70.    TextColor(2);
  71.    GoToXY(4,7);   Write(BStr,'      ');
  72.    Str(GW:5:3,GStr);
  73.    TextColor(3);
  74.    GoToXY(4,9);   Write(GStr,'      ');
  75.    GoToXY(4,10);  Write('Rho (Mag)   ');
  76.    Str(RhoMagReal:5:3,RhoStr);
  77.    GoToXY(4,11);  Write(RhoStr,'     ');
  78.    GoToXY(4,12);  Write('Rho (Ang)   ');
  79.    RhoAngReal := -180*RhoAngReal/Pi;
  80.    Str(RhoAngReal:5:3,PsiStr);
  81.    RhoAngReal := -Pi*RhoAngReal/180;
  82.    GoToXY(4,13);  Write(PsiStr,'     ');
  83.    GoToXY(4,14);  Write('VSWR        ');
  84.    CalcVSWR;
  85.    Str(VSWR:5:3,VSWRStr);
  86.    GoToXY(4,15);  Write(VSWRStr,'    ');
  87.  
  88. END;
  89.  
  90.  
  91. PROCEDURE InputVariables;
  92. BEGIN
  93.    GotoXY(2,25);
  94.    Str(Z0:5:3,Z0Str);
  95.    Write(' Type in Z0  ',Z0Str,'          ');
  96.    GotoXY(14,25);
  97.    Read(Z0);
  98.    Str(R:5:3,RStr);
  99.    GotoXY(2,25);
  100.    Write(' Type in R   ',RStr,'          ');
  101.    GotoXY(14,25);
  102.    Read(R);
  103.    Str(X:5:3,XStr);
  104.    GotoXY(2,25);
  105.    Write(' Type in X   ',XStr,'          ');
  106.    GotoXY(14,25);
  107.    Read(X);
  108.    If X=0 then X:=1E-6;
  109.    If R=0 then R:=1E-6;
  110. END;
  111.  
  112. PROCEDURE NormalizeX;
  113. BEGIN
  114.    Rn := R/Z0;
  115.    Xn := X/Z0;
  116. {   Bn := B*Z0;
  117.    Gn := G*Z0;
  118. }END;
  119.  
  120. PROCEDURE background;
  121. BEGIN
  122.    GraphColorMode;
  123.    Palette(2);
  124.    Circle(CenterX,CenterY,100,1);
  125.    Circle(CenterX+50,CenterY,50,1);
  126.    Circle(CenterX+75,CenterY,25,1);
  127.    Circle(CenterX+25,CenterY,75,1);
  128.    Circle(CenterX-50,CenterY,50,2);
  129.    Circle(CenterX-75,CenterY,25,2);
  130.    Circle(CenterX-25,CenterY,75,2);
  131.  
  132. END;
  133.  
  134. PROCEDURE PlotRho;
  135. BEGIN
  136.    RhoReal := round(100*RhoRealReal);
  137.    RhoImag := round(100*RhoImagReal);
  138.    Xplot := CenterX + RhoReal;
  139.    Yplot := CenterY + RhoImag;
  140.    Circle(Xplot,Yplot,3,3);
  141. END;
  142.  
  143. PROCEDURE CalcRhoFromZ;
  144. BEGIN
  145.    DeltaX := Sqr(Rn+1)+Sqr(Xn);
  146.    RhoRealReal:= (Sqr(Rn)-1+Sqr(Xn))/DeltaX;
  147.    RhoImagReal:= 2*Xn/DeltaX;
  148. END;
  149.  
  150. PROCEDURE CalcZfromRho;
  151. BEGIN
  152.    DeltaZRho := Sqr(1-RhoRealReal)+Sqr(RhoImagReal);
  153.    Rn:= (1-Sqr(RhoRealReal)-Sqr(RhoImagReal))/DeltaZRho;
  154.    Xn:= 2*RhoImagReal/DeltaZRho;
  155. END;
  156.  
  157. PROCEDURE CalcRhoFromY;
  158. BEGIN
  159.    DeltaB := Sqr(Gn+1)+Sqr(Bn);
  160.    RhoRealReal:= (1-Sqr(Gn)-Sqr(Bn))/DeltaB;
  161.    RhoImagReal:=-2*Bn/DeltaB;
  162.  
  163. END;
  164.  
  165. PROCEDURE CalcYfromRho;
  166. BEGIN
  167.    DeltaYRho := Sqr(1+RhoRealReal)+Sqr(RhoImagReal);
  168.    Gn:=  (1-Sqr(RhoRealReal)-Sqr(RhoImagReal))/DeltaYRho;
  169.    Bn:=-2*RhoImagReal/DeltaYRho;
  170. END;
  171.  
  172. PROCEDURE CalcPolarRho;
  173. BEGIN
  174.    RhoMagReal := Sqrt(Sqr(RhoRealReal)+Sqr(RhoImagReal));
  175.    RhoAngReal := ArcTan(RhoImagReal/RhoRealReal);
  176.    IF (RhoRealReal<0) THEN RhoAngReal := RhoAngReal - Pi;
  177. END;
  178.  
  179. PROCEDURE CalcRectRho;
  180.    BEGIN
  181.    RhoRealReal := RhoMagReal*Cos(RhoAngReal);
  182.    RhoImagReal := RhoMagReal*Sin(RhoAngReal);
  183.    END;
  184.  
  185. PROCEDURE CalcVSWR;
  186. BEGIN
  187.    VSWR :=(1+RhoMagReal)/(1-RhoMagReal);
  188. END;
  189.  
  190. PROCEDURE IncrementX;
  191. BEGIN
  192.    CalcZfromRho;
  193.    Xn := Xn + IncX;
  194.    N := N+1;
  195.    CalcRhoFromZ;
  196.    PlotRho;
  197.    NewWrite;
  198.    XincReal := N*IncX*Z0;
  199.    GoToXY(4,22);
  200.    Write('X',M       );
  201.    Str(XincReal:5:3,XincStr);
  202.    GoToXY(4,23);
  203.    Write(XincStr);
  204.    Str(M,MStr);
  205.    MStr := Concat('X',MStr);
  206.    DataLabel[M] := MStr;
  207.    DataValue[M] := XincStr;
  208. END;
  209.  
  210.  
  211. PROCEDURE DecrementX;
  212. BEGIN
  213.    CalcZfromRho;
  214.    Xn := Xn - IncX;
  215.    N := N-1;
  216.    CalcRhoFromZ;
  217.    PlotRho;
  218.    NewWrite;
  219.    XincReal := N*IncX*Z0;
  220.    GoToXY(4,22);
  221.    Write('X',M       );
  222.    Str(XincReal:5:3,XincStr);
  223.    GoToXY(4,23);
  224.    Write(XincStr);
  225.    Str(M,MStr);
  226.    MStr := Concat('X',MStr);
  227.    DataLabel[M] := MStr;
  228.    DataValue[M] := XincStr;
  229. END;
  230.  
  231. PROCEDURE Decrement10X;
  232. BEGIN
  233.    CalcZfromRho;
  234.    Xn := Xn - 10*IncX;
  235.    N := N-10;
  236.    CalcRhoFromZ;
  237.    PlotRho;
  238.    NewWrite;
  239.    XincReal := N*IncX*Z0;
  240.    GoToXY(4,22);
  241.    Write('X',M       );
  242.    Str(XincReal:5:3,XincStr);
  243.    GoToXY(4,23);
  244.    Write(XincStr);
  245.    Str(M,MStr);
  246.    MStr := Concat('X',MStr);
  247.    DataLabel[M] := MStr;
  248.    DataValue[M] := XincStr;
  249. END;
  250.  
  251. PROCEDURE Increment10X;
  252. BEGIN
  253.    CalcZfromRho;
  254.    Xn := Xn + 10*IncX;
  255.    N  := N  + 10;
  256.    CalcRhoFromZ;
  257.    PlotRho;
  258.    NewWrite;
  259.    XincReal := N*IncX*Z0;
  260.    GoToXY(4,22);
  261.    Write('X',M       );
  262.    Str(XincReal:5:3,XincStr);
  263.    GoToXY(4,23);
  264.    Write(XincStr);
  265.    Str(M,MStr);
  266.    MStr := Concat('X',MStr);
  267.    DataLabel[M] := MStr;
  268.    DataValue[M] := XincStr;
  269. END;
  270.  
  271.  
  272. PROCEDURE IncrementB;
  273. BEGIN
  274.    CalcYfromRho;
  275.    Bn := Bn + IncB;
  276.    N  := N  + 1;
  277.    CalcRhoFromY;
  278.    PlotRho;
  279.    NewWrite;
  280.    BincReal := N*IncB/Z0;
  281.    GoToXY(4,22);
  282.    Write('B',M       );
  283.    Str(BincReal:5:3,BincStr);
  284.    GoToXY(4,23);
  285.    Write(BincStr);
  286.    Str(M,MStr);
  287.    MStr := Concat('B',MStr);
  288.    DataLabel[M] := MStr;
  289.    DataValue[M] := BincStr;
  290. END;
  291.  
  292. PROCEDURE DecrementB;
  293. BEGIN
  294.    CalcYfromRho;
  295.    Bn := Bn - IncB;
  296.    N  := N  - 1;
  297.    CalcRhoFromY;
  298.    PlotRho;
  299.    NewWrite;
  300.    BincReal := N*IncB/Z0;
  301.    GoToXY(4,22);
  302.    Write('B',M       );
  303.    Str(BincReal:5:3,BincStr);
  304.    GoToXY(4,23);
  305.    Write(BincStr);
  306.    Str(M,MStr);
  307.    MStr := Concat('B',MStr);
  308.    DataLabel[M] := MStr;
  309.    DataValue[M] := BincStr;
  310. END;
  311.  
  312.  
  313. PROCEDURE Increment10B;
  314. BEGIN
  315.    CalcYfromRho;
  316.    Bn := Bn + 10*IncB;
  317.    N  := N  + 10;
  318.    CalcRhoFromY;
  319.    PlotRho;
  320.    NewWrite;
  321.    BincReal := N*IncB/Z0;
  322.    GoToXY(4,22);
  323.    Write('B',M       );
  324.    Str(BincReal:5:3,BincStr);
  325.    GoToXY(4,23);
  326.    Write(BincStr);
  327.    Str(M,MStr);
  328.    MStr := Concat('B',MStr);
  329.    DataLabel[M] := MStr;
  330.    DataValue[M] := BincStr;
  331. END;
  332.  
  333. PROCEDURE Decrement10B;
  334. BEGIN
  335.    CalcYfromRho;
  336.    Bn := Bn - 10*IncB;
  337.    N  := N  - 10;
  338.    CalcRhoFromY;
  339.    PlotRho;
  340.    NewWrite;
  341.    BincReal := N*IncB/Z0;
  342.    GoToXY(4,22);
  343.    Write('B',M       );
  344.    Str(BincReal:5:3,BincStr);
  345.    GoToXY(4,23);
  346.    Write(BincStr);
  347.    Str(M,MStr);
  348.    MStr := Concat('B',MStr);
  349.    DataLabel[M] := MStr;
  350.    DataValue[M] := BincStr;
  351. END;
  352.  
  353.  
  354. PROCEDURE DecrementRho;
  355. BEGIN
  356.    CalcPolarRho;
  357.    RhoAngReal := RhoAngReal + IncRho;
  358.    CalcRectRho;
  359.    N  := N  + 1;
  360.    PlotRho;
  361.    NewWrite;
  362.    RhoIncReal := -90*N*IncRho/Pi;
  363.    GoToXY(4,22);
  364.    Write('A',M       );
  365.    Str(RhoIncReal:5:3,RhoIncStr);
  366.    GoToXY(4,23);
  367.    Write(RhoIncStr);
  368.    Str(M,MStr);
  369.    MStr := Concat('A',MStr);
  370.    DataLabel[M] := MStr;
  371.    DataValue[M] := RhoincStr;
  372. END;
  373.  
  374. PROCEDURE IncrementRho;
  375. BEGIN
  376.    CalcPolarRho;
  377.    RhoAngReal := RhoAngReal - IncRho;
  378.    CalcRectRho;
  379.    N  := N  - 1;
  380.    PlotRho;
  381.    NewWrite;
  382.    RhoIncReal := -90*N*IncRho/Pi;
  383.    GoToXY(4,22);
  384.    Write('A',M       );
  385.    Str(RhoIncReal:5:3,RhoIncStr);
  386.    GoToXY(4,23);
  387.    Write(RhoIncStr);
  388.    Str(M,MStr);
  389.    MStr := Concat('A',MStr);
  390.    DataLabel[M] := MStr;
  391.    DataValue[M] := RhoincStr;
  392. END;
  393.  
  394. PROCEDURE Decrement10Rho;
  395. BEGIN
  396.    CalcPolarRho;
  397.    RhoAngReal := RhoAngReal + 10*IncRho;
  398.    CalcRectRho;
  399.    N  := N  + 10;
  400.    PlotRho;
  401.    NewWrite;
  402.    RhoIncReal := -90*N*IncRho/Pi;
  403.    GoToXY(4,22);
  404.    Write('A',M       );
  405.    Str(RhoIncReal:5:3,RhoIncStr);
  406.    GoToXY(4,23);
  407.    Write(RhoIncStr);
  408.    Str(M,MStr);
  409.    MStr := Concat('A',MStr);
  410.    DataLabel[M] := MStr;
  411.    DataValue[M] := RhoincStr;
  412. END;
  413.  
  414. PROCEDURE Increment10Rho;
  415. BEGIN
  416.    CalcPolarRho;
  417.    RhoAngReal := RhoAngReal - 10*IncRho;
  418.    CalcRectRho;
  419.    N  := N  - 10;
  420.    PlotRho;
  421.    NewWrite;
  422.    RhoIncReal := -90*N*IncRho/Pi;
  423.    GoToXY(4,22);
  424.    Write('A',M       );
  425.    Str(RhoIncReal:5:3,RhoIncStr);
  426.    GoToXY(4,23);
  427.    Write(RhoIncStr);
  428.    Str(M,MStr);
  429.    MStr := Concat('A',MStr);
  430.    DataLabel[M] := MStr;
  431.    DataValue[M] := RhoincStr;
  432. END;
  433.  
  434.  
  435. PROCEDURE ChangeX;
  436. BEGIN
  437.    GoToXY(2,19);
  438.    Write('MOVE MODE   ');
  439.    GoToXY(2,20);
  440.    Write('F10 to COMMAND ');
  441.    GoToXY(2,21);
  442.    TextColor(1);
  443.    Write('Changing X       ');
  444.    TextColor(3);
  445.    GoToXY(2,22);
  446.    Write('                 ');
  447.    GoToXY(2,23);
  448.    Write('                 ');
  449.    GoToXY(2,24);
  450.    Write('                   ');
  451.    GoToXY(2,25);
  452.    Write('                     ');
  453.    N := 0; M := M + 1; done := false;
  454.    WHILE Done = false do
  455.    BEGIN
  456.       Read (Kbd,Ch);
  457.       IF (Ch = #27) AND KeyPressed THEN
  458.          Read (Kbd,Ch);
  459.             IF Ch in [#59..#68] THEN
  460.                Case  Ch of
  461.                   #59      : IncrementX;
  462.                   #60      : DecrementX;
  463.                   #61      : Increment10X;
  464.                   #62      : Decrement10X;
  465.                   #68      : Done := True;
  466.                END;
  467.    END;
  468.    done := false;
  469.    GoToXY(2,20);
  470.    Write('               ');
  471.    GoToXY(2,21);
  472.    Write('               ');
  473.  
  474. END;
  475.  
  476. PROCEDURE ChangeB;
  477. BEGIN
  478.    GoToXY(2,19);
  479.    Write('MOVE MODE   ');
  480.    GoToXY(2,20);
  481.    Write('F10 to COMMAND ');
  482.    GoToXY(2,21);
  483.    TextColor(2);
  484.    Write('Changing B      ');
  485.    TextColor(3);
  486.    GoToXY(2,22);
  487.    Write('                ');
  488.    GoToXY(2,23);
  489.    Write('                ');
  490.    GoToXY(2,24);
  491.    Write('                   ');
  492.    GoToXY(2,25);
  493.    Write('                     ');
  494.    N := 0; M := M + 1; done := false;
  495.    WHILE Done = false do
  496.    BEGIN
  497.       Read (Kbd,Ch);
  498.       IF (Ch = #27) AND KeyPressed THEN
  499.          Read (Kbd,Ch);
  500.             IF Ch in [#59..#68] THEN
  501.                Case  Ch of
  502.                   #59      : IncrementB;
  503.                   #60      : DecrementB;
  504.                   #61      : Increment10B;
  505.                   #62      : Decrement10B;
  506.                   #68      : Done := True;
  507.                END;
  508.    END;
  509.    done := false;
  510.    GoToXY(2,20);
  511.    Write('               ');
  512.    GoToXY(2,21);
  513.    Write('               ');
  514.  
  515. END;
  516.  
  517. PROCEDURE ChangeRho;
  518.    BEGIN
  519.    GoToXY(2,19);
  520.    Write('MOVE MODE   ');
  521.    GoToXY(2,20);
  522.    Write('F10 to COMMAND ');
  523.    GoToXY(2,21);
  524.    Write('Changing A      ');
  525.    GoToXY(2,22);
  526.    Write('                ');
  527.    GoToXY(2,23);
  528.    Write('                ');
  529.    GoToXY(2,24);
  530.    Write('                   ');
  531.    GoToXY(2,25);
  532.    Write('                     ');
  533.    N := 0; M := M + 1; done := false;
  534.    WHILE Done = false do
  535.       BEGIN
  536.          Read (Kbd,Ch);
  537.          IF (Ch = #27) AND KeyPressed THEN
  538.             Read (Kbd,Ch);
  539.             IF Ch in [#59..#62,#68] THEN
  540.             Case  Ch of
  541.                #59      : IncrementRho;         (* F1 *)
  542.                #60      : DecrementRho;         (* F2 *)
  543.                #61      : Increment10Rho;       (* F3 *)
  544.                #62      : Decrement10Rho;       (* F4 *)
  545.                #68      : Done := True;         (* F10 *)
  546.       END;
  547.  
  548.    END;
  549.    done := false;
  550.    GoToXY(2,20);
  551.    Write('               ');
  552.    GoToXY(2,21);
  553.    Write('               ');
  554.  
  555. END;
  556.  
  557. PROCEDURE DataTable;
  558. BEGIN
  559.    GoToXY(4,2);   Write('DATA TABLE');
  560.    For index := 1 to M do
  561.       BEGIN
  562.       GoToXY(4,(2+index));
  563.       Write(DataLabel[index],' = ',DataValue[index]);
  564.       END;
  565.    GoToXY(4,(3+index)); Write('           ');
  566. END;
  567.  
  568. BEGIN
  569.    Done := false;
  570.    R := 1; X := 1; Z0 :=1;
  571.    Title;
  572.    Help;
  573.    Start:
  574.    InputVariables;
  575.    ReDo:
  576.    M := 0;
  577.    NormalizeX;
  578.    CalcRhoFromZ;
  579.    Background;
  580.    NewWrite;
  581.    PlotRho;
  582.    While Done = false do
  583.       BEGIN
  584.          GoToXY(2,19);
  585.          Write('COMMAND MODE');
  586.          GoToXY(2,21);
  587.          TextColor(1);
  588.          Write('Change X    = F5 ');
  589.          GoToXY(2,22);
  590.          TextColor(2);
  591.          Write('Change B    = F6 ');
  592.          GoToXY(2,23);
  593.          TextColor(3);
  594.          Write('Change Angl = F7');
  595.          GoToXY(2,24);
  596.          Write('Redo=F8 New=F9 Quit');
  597.          GoToXY(2,25);
  598.          TextColor(2);
  599.          Write('DATA TABLE = ALT F9');
  600.          GoToXY(15,25);
  601.          TextColor(3);
  602.          Read(Kbd,Ch);
  603.          IF (Ch = Chr(27)) AND KeyPressed THEN
  604.             Read(Kbd,Ch);
  605.             IF Ch in [#71,#63..#68,#112,'q','Q'] THEN
  606.                Case  Ch of
  607.                   #63      : ChangeX;              (* F5 *)
  608.                   #64      : ChangeB;              (* F6 *)
  609.                   #65      : ChangeRho;            (* F7 *)
  610.                   #66      : GoTo ReDo;            (* F8 *)
  611.                   #67      : GoTo start;           (* F9 *)
  612.                   'Q'      : Done := True;         (* Quit *)
  613.                   'q'      : Done := True;         (* Quit *)
  614.                   #112     : DataTable;            (* Alt F9 *)
  615.                   #71      : Help;
  616.             END;
  617.  
  618.       END;
  619.    TextMode;
  620.    GoToXY(0,5);
  621.    WriteLn('DATA TABLE');
  622.    For index := 1 to M do
  623.       BEGIN
  624.       WriteLn(DataLabel[index],' = ',DataValue[index]);
  625.       END;
  626. END.
  627.