home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / tech / eepub15 / spurfreq.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-07-23  |  12.3 KB  |  334 lines
  1. {   originally written for HP85   by E. GREENWALD
  2.     converted to Apple by C J Dockstader 12/15/84 last Rev 9/9/85
  3.     converted to MS DOS  Turbo Pascal 3.02A  July 87 ....  C J D}
  4.  
  5. program SPURFREQ;
  6.   const TDN = '8 12 PM July 23 1987';
  7.   var Ch : char;
  8.       LIF, HIF, LRF, HRF, FLO, TempS : string[10];
  9.       A, B, L, P, R, X1, X2, Y, Y1, Y2, Y3, Y4, Y5, Y6, Z : real;
  10.       Err, I, J, JJ, M, N, Q : integer;
  11.  
  12. procedure Zero;
  13.   begin draw(I-1,J,I+1,J,1); draw(I+2,J+1,I+2,J+5,1);
  14.     draw(I+1,J+6,I-1,J+6,1); draw(I-2,J+5,I-2,J+1,1); end;
  15.  
  16. procedure One;
  17.   begin plot(I-1,J+1,1); draw(I,J,I,J+5,1); draw(I-1,J+6,I+1,J+6,1); end;
  18.  
  19. procedure Two;
  20.   begin plot(I-2,J+1,1); draw(I-1,J,I+1,J,1); draw(I+2,J+1,I-2,J+5,1);
  21.     draw(I-2,J+6,I+2,J+6,1); end;
  22.  
  23. procedure Three;
  24.   begin plot(I-2,J+1,1);draw(I-1,J,I+1,J,1);draw(I+2,J+1,I+2,J+2,1);plot(I+1,J
  25.     +3,1);draw(I+2,J+4,I+2,J+5,1);draw(I+1,J+6,I-1,J+6,1);plot(I-2,J+5,1); end;
  26.  
  27. procedure Four;
  28.   begin draw(I+1,J,I+1,J+6,1); draw(I-2,J+4,I+2,J+4,1);
  29.     draw(I-2,J+3,I+1,J,1); end;
  30.  
  31. procedure Five;
  32.   begin draw(I+2,J,I-2,J,1); draw(I-2,J,I-1,J+2,1); draw(I-2,J+2,I+1,J+2,1);
  33.     draw(I+2,J+3,I+2,J+5,1); draw(I+1,J+6,I-1,J+6,1); plot(I-2,J+5,1); end;
  34.  
  35. procedure Six;
  36.   begin draw(I+1,J,I-1,J,1); draw(I-2,J+1,I-2,J+5,1); draw(I-1,J+6,I+1,J+6,1);
  37.     draw(I+2,J+5,I+2,J+4,1); draw(I+1,J+3,I-1,J+3,1); end;
  38.  
  39. procedure Seven;
  40.   begin draw(I-2,J,I+2,J,1); draw(I+2,J+1,I-2,J+5,1); plot(I-2,J+6,1); end;
  41.  
  42. procedure Eight;
  43.   begin draw(I-1,J,I+1,J,1); draw(I+2,J+1,I+2,J+2,1); draw(I+2,J+4,I+2,J+5,1);
  44.     draw(I+1,J+6,I-1,J+6,1); draw(I-2,J+5,I-2,J+4,1); draw(I-2,J+2,I-2,J+1,1);
  45.     draw(I-1,J+3,I+1,J+3,1); end;
  46.  
  47. procedure Nine;
  48.   begin draw(I-1,J,I+1,J,1); draw(I+2,J+1,I+2,J+5,1); draw(I+1,J+6,I-1,J+6,1);
  49.     draw(I+1,J+3,I-1,J+3,1); draw(I-2,J+2,I-2,J+1,1); end;
  50.  
  51. procedure DP;
  52.   begin draw(I-1,J+4,I+1,J+4,1); plot(I-1,J+5,1); plot(I+1,J+5,1);
  53.     draw(I-1,J+6,I+1,J+6,1); end;
  54.  
  55. procedure Equals;
  56.   begin draw(I-1,J+2,I+1,J+2,1); draw(I-1,J+4,I+1,J+4,1); end;
  57.  
  58. procedure LetterF;
  59.   begin draw(I-2,J,I-2,J+6,1); draw(I-1,J,I+2,J,1); draw(I-1,J+3,I+1,J+3,1);
  60.   end;
  61.  
  62. procedure LetterI;
  63.   begin draw(I-1,J,I+1,J,1); draw(I,J+1,I,J+5,1); draw(I-1,J+6,I+1,J+6,1);
  64.   end;
  65.  
  66. procedure LetterL;
  67.   begin draw(I-2,J,I-2,J+6,1); draw(I-1,J+6,I+2,J+6,1); end;
  68.  
  69. procedure LetterO;
  70.   begin draw(I-1,J,I+1,J,1); draw(I+2,J+1,I+2,J+5,1); draw(I-2,J+1,I-2,J+5,1);
  71.     draw(I-1,J+6,I+1,J+6,1); end;
  72.  
  73. procedure LetterR;
  74.   begin draw(I-2,J,I-2,J+6,1); draw(I-1,J,I+1,J,1); draw(I+2,J+1,I+2,J+2,1);
  75.     draw(I-1,J+3,I+1,J+3,1); draw(I,J+4,I+2,J+6,1); end;
  76.  
  77. procedure Beep; begin Sound(440); Delay(150); NoSound end;
  78.  
  79. procedure LowIF;
  80.   begin gotoXY(43,5); read(TempS); writeln('      ');
  81.     if TempS = '' then
  82.     begin str(A:4:4,TempS); gotoXY(43,5); writeln(TempS,'      '); end
  83.     else begin LIF := TempS; val(TempS,A,Err); str(A:4:4,TempS);
  84.       gotoXY(43,5); writeln(TempS,'      '); end;
  85.   end;
  86.  
  87. procedure HighIF;
  88.   begin gotoXY(43,6); read(TempS); writeln('      ');
  89.     if TempS = '' then
  90.     begin str(B:4:4,TempS); gotoXY(43,6); writeln(TempS,'      '); end
  91.     else begin HIF := TempS; val(TempS,B,Err); str(B:4:4,TempS);
  92.       gotoXY(43,6); writeln(TempS,'      '); end;
  93.   end;
  94.  
  95. procedure LowRF;
  96.   begin gotoXY(43,7); read(TempS); writeln('      ');
  97.     if TempS = '' then
  98.     begin str(Y:4:4,TempS); gotoXY(43,7); writeln(TempS,'      '); end
  99.     else begin LRF := TempS; val(TempS,Y,Err); str(Y:4:4,TempS);
  100.       gotoXY(43,7); writeln(TempS,'      '); end;
  101.   end;
  102.  
  103. procedure HighRF;
  104.   begin gotoXY(43,8); read(TempS); writeln('      ');
  105.     if TempS = '' then
  106.     begin str(Z:4:4,TempS); gotoXY(43,8); writeln(TempS,'      '); end
  107.     else begin HRF := TempS; val(TempS,Z,Err); str(Z:4:4,TempS);
  108.       gotoXY(43,8); writeln(TempS,'      '); end;
  109.   end;
  110.  
  111. procedure FixedLO;
  112.   begin gotoXY(43,9); read(TempS); writeln('      ');
  113.     if TempS = '' then
  114.     begin str(L:4:4,TempS); gotoXY(43,9); writeln(TempS,'      '); end
  115.     else begin FLO := TempS; val(TempS,L,Err); str(L:4:4,TempS);
  116.       gotoXY(43,9); writeln(TempS,'      '); end;
  117.   end;
  118.  
  119. procedure Order;
  120.   begin gotoXY(43,10); read(TempS); writeln('      ');
  121.     if TempS = '' then
  122.     begin str(Q:4,TempS); gotoXY(43,10); writeln(TempS,'      '); end
  123.     else val(TempS,Q,Err);
  124.   end;
  125.  
  126.  
  127. procedure Menu;
  128.   begin clrscr; gotoXY(16,1);
  129.     writeln('MIXER SPURIOUS FREQUENCY RESPONSES'); gotoXY(5,3);
  130.     writeln('"I"nstructions   "E"nter data   "C"alculate   "Q"uit');
  131.     str(A:4:4,TempS); gotoXY(15,5);
  132.     writeln('  Low frequency end of I.F. ',TempS);
  133.     str(B:4:4,TempS); gotoXY(15,6);
  134.     writeln(' High frequency end of I.F. ',TempS);
  135.     str(Y:4:4,TempS); gotoXY(15,7);
  136.     writeln('  Low frequency end of R.F. ',TempS);
  137.     str(Z:4:4,TempS); gotoXY(15,8);
  138.     writeln(' High frequency end of R.F. ',TempS);
  139.     str(L:4:4,TempS); gotoXY(15,9);
  140.     writeln('  Fixed Local Oscillator    ',TempS);
  141.     gotoXY(15,10); writeln('  Maximum order required    ',Q);
  142.   end;
  143.  
  144. procedure Instructions;
  145.   begin clrscr; gotoXY(16,1); writeln('MIXER SPURIOUS FREQUENCY RESPONSES');
  146.     writeln; writeln('    Use a common frequency unit.'); writeln;
  147.     writeln('    For the I.F. Low and High frequencies, use a bandpass that');
  148.     writeln('         spurs are objectionable.'); writeln;
  149.     write('    For the R.F. Low and High frequencies, do the same as for ');
  150.     writeln('the I.F.'); writeln;
  151.     writeln('    On the graph the left digit is the L.O. multiple.'); writeln;
  152.     writeln('    The right digit is the R.F. multiple.');
  153.     writeln; writeln; writeln;
  154.     writeln(' originally written for HP85   by E. GREENWALD');
  155.     writeln(' converted to Apple by C J Dockstader 12/15/84 last Rev 9/9/85');
  156.     writeln(' converted to MS DOS   Turbo Pascal  July 87   C J D');
  157.     writeln('Rev.   ',TDN,'   C J D'); read(kbd,Ch);
  158.   end;
  159.  
  160. procedure Border;
  161.   begin draw(0,0,319,0,2); draw(319,0,319,199,2);
  162.     draw(319,199,0,199,2); draw(0,199,0,0,2);
  163.   end;
  164.  
  165. procedure Hticks;
  166.   begin Y1 := ln((Z-Y)/3)/ln(10);
  167.     Y2 := exp(int(Y1)*ln(10))/2*exp(int((Y1-int(Y1))/0.34)*ln(2));
  168.     Y3 := int(Y/Y2)*Y2; Y4 := 320*((int(Y/Y2)+1)*Y2-Y)/(Z-Y);
  169.     while Y4 < 320 do
  170.     begin Y5 := 0.0; while Y5 < 200 do
  171.       begin draw(round(Y4),round(Y5),round(Y4),round(Y5+4),2); Y5:=Y5+195;
  172.       end; Y4 := Y4 + 320*Y2/(Z-Y);
  173.     end;
  174.   end;
  175.  
  176. procedure Vticks;
  177.   begin Y1 := ln((B-A)/3)/ln(10);
  178.     Y2 := exp(int(Y1)*ln(10))/2*exp(int((Y1-int(Y1))/0.34)*ln(2));
  179.     Y3 := int(A/Y2)*Y2; Y4 := 200-200*((int(A/Y2)+1)*Y2-A)/(B-A);
  180.     while Y4 > 0 do
  181.     begin Y5 := 0.0; while Y5 < 320 do
  182.       begin draw(round(Y5),round(Y4),round(Y5+4),round(Y4),2); Y5:=Y5+315;
  183.       end; Y4 := Y4 - 200*Y2/(B-A);
  184.     end;
  185.   end;
  186.  
  187. procedure Hlabel;
  188.   begin I := 150; J:= 190; LetterR; I := 156; LetterF; end;
  189.  
  190. procedure Vlabel;
  191.   begin I := 6; J := 97; LetterI; I := 12; LetterF; end;
  192.  
  193. procedure LOlabel;
  194.   begin I := 268; J := 170; LetterL; I := 274; LetterO;
  195.   I := 280; Equals; end;
  196.  
  197. procedure LabelValue;
  198.   begin I := I + 6; if TempS = '0' then Zero;
  199.      if TempS = '1' then One;   if TempS = '2' then Two;
  200.      if TempS = '3' then Three; if TempS = '4' then Four;
  201.      if TempS = '5' then Five;  if TempS = '6' then Six;
  202.      if TempS = '7' then Seven; if TempS = '8' then Eight;
  203.      if TempS = '9' then Nine;  if TempS = '.' then DP;
  204.   end;
  205.  
  206. procedure Hvariables;
  207.   begin  I := 12; J := 190; M := length(LRF);
  208.     for N := 1 to M do begin TempS := copy(LRF,N,1); LabelValue; end;
  209.     I := 280; J := 190; M := length(HRF);
  210.     for N := 1 to M do begin TempS := copy(HRF,N,1); LabelValue; end;
  211.   end;
  212.  
  213. procedure Vvariables;
  214.   begin  I := 0; J := 5; M := length(HIF);
  215.     for N := 1 to M do begin TempS := copy(HIF,N,1); LabelValue; end;
  216.     I := 0; J := 180; M := length(LIF);
  217.     for N := 1 to M do begin TempS := copy(LIF,N,1); LabelValue; end;
  218.   end;
  219.  
  220. procedure LOvariable;
  221.   begin  I := 280; J := 170; M := length(FLO);
  222.     for N := 1 to M do begin TempS := copy(FLO,N,1); LabelValue; end;
  223.   end;
  224.  
  225. procedure Sub1;  begin X1 := 319.0 * (A-P)/(R-P); end;
  226.  
  227. procedure Sub2;  begin X1 := 319.0 * (B-P)/(R-P); end;
  228.  
  229. procedure Sub3;  begin X2 := 319.0 * (B-P)/(R-P); end;
  230.  
  231. procedure Sub4;  begin X2 := 319.0 * (A-P)/(R-P); end;
  232.  
  233. procedure Sub5;  begin Y1 := 199.0 * (B-P)/(B-A); end;
  234.  
  235. procedure Sub6;  begin Y2 := 199.0 * (B-R)/(B-A); end;
  236.  
  237. procedure Interpolation;
  238.   begin if P > R then
  239.     begin
  240.       if (P>B) and (A>=R) then begin Sub2; Y1 := 0.0; Sub4; Y2 := 199.0; end
  241.         else if A>=R then begin X1 := 0.0; Sub5; Sub4; Y2 := 199.0; end
  242.         else if P>B then begin Sub2; Y1 := 0.0; X2 := 319.0; Sub6; end
  243.         else begin X1 := 0.0; Sub5; X2 := 319.0; Sub6; end;
  244.     end else
  245.     begin
  246.       if (P<=A) and (R>B) then begin Sub1; Y1 := 199.0; Sub3; Y2 := 0.0; end
  247.         else if A>=P then begin Sub1; Y1 := 199.0; X2 := 319.0; Sub6; end
  248.         else if R>B then begin X1 := 0.0; Sub5; Sub3; Y2 := 0.0; end
  249.         else begin X1 := 0.0; Sub5; X2 := 319.0; Sub6; end;
  250.     end;
  251.   end;
  252.  
  253. procedure OrderLabel;
  254.   begin J := J + 8; JJ := J;
  255.     if (Y1<1) and (Y2>198) then I := round((J+4)/200.0*(X2-X1)+X1)
  256.     else begin if (Y1>198) and (Y2<1) then I := round((J+4)/200.0*(X1-X2)+X2)
  257.     else begin JJ := JJ-8; I := round((X2-X1)/2+X1); J := round((Y2-Y1)/2+Y1);
  258.          end; end; draw(I,J+3,I+8,J+3,1); I := I + 12;
  259.     if M = 1 then One; if M = 2 then Two; if M = 3 then Three;
  260.     if M = 4 then Four; if M = 5 then Five; if M = 6 then Six;
  261.     if M = 7 then Seven; if M = 8 then Eight; if M = 9 then Nine;
  262.     if M = 10 then begin One; I := I+6; Zero; end;
  263.     if M = 11 then begin One; I := I+6; One; end;
  264.     if M = 12 then begin One; I := I+6; Two; end;
  265.     if M = 13 then begin One; I := I+6; Three; end;
  266.     if M = 14 then begin One; I := I+6; Four; end;
  267.     if M = 15 then begin One; I := I+6; Five; end;
  268.     draw(I+4,J+3,I+6,J+3,1); I := I+10;
  269.     if N = 1 then One; if N = 2 then Two; if N = 3 then Three;
  270.     if N = 4 then Four; if N = 5 then Five; if N = 6 then Six;
  271.     if N = 7 then Seven; if N = 8 then Eight; if N = 9 then Nine;
  272.     if N = 10 then begin One; I := I+6; Zero; end;
  273.     if N = 11 then begin One; I := I+6; One; end;
  274.     if N = 12 then begin One; I := I+6; Two; end;
  275.     if N = 13 then begin One; I := I+6; Three; end;
  276.     if N = 14 then begin One; I := I+6; Four; end;
  277.     if N = 15 then begin One; I := I+6; Five; end;
  278.     if N = 16 then begin One; I := I+6; Six; end;
  279.     if N = 17 then begin One; I := I+6; Seven; end; J := JJ;
  280.   end;
  281.  
  282. procedure Graph1;
  283.   begin Interpolation; draw(round(X1),round(Y1),round(X2),round(Y2),3);
  284.     OrderLabel;
  285.   end;
  286.  
  287. procedure Graph2;
  288.   begin R:=-R; Interpolation; draw(round(X1),round(Y1),round(X2),round(Y2),3);
  289.     OrderLabel; R:=-R; P:=-P; Interpolation;
  290.     draw(round(X1),round(Y1),round(X2),round(Y2),3); OrderLabel;
  291.   end;
  292.  
  293. procedure SpurHunt;
  294.   begin J := 16; N := 1; for M := 1 to Q-N+1 do
  295.     begin for N := 1 to Q-M do
  296.       begin P := M*L+N*Y; R := M*L+N*Z;
  297.         if (P>=A) and (P<=B) then Graph1
  298.         else if (R>=A) and (R<=B) then Graph1
  299.         else if (P<=A) and (R>=B) then Graph1;
  300.         P := M*L-N*Y; R := M*L-N*Z;
  301.         if ((P<0.0) and (R>0.0)) or ((P>0.0) and (R<0.0)) then
  302.         begin P := abs(P); R := abs(R);
  303.           if (P<A) and (A>R) then else Graph2;
  304.         end else
  305.         begin P := abs(P); R := abs(R);
  306.           if (P>=A) and (P<=B) then Graph1
  307.           else if (R>=A) and (R<=B) then Graph1
  308.           else if (P<=A) and (R>=B) then Graph1
  309.           else if (R<=A) and (P>=B) then Graph1;
  310.         end;
  311.       end;
  312.     end;
  313.   end;
  314.  
  315. procedure ZeroVar;
  316.   begin A := 0.0; B := 0.0; Y := 0.0; Z := 0.0; L := 0.0; Q := 10; end;
  317.  
  318. BEGIN
  319.   ZeroVar;
  320.   repeat Menu; gotoXY(60,3); read(kbd,Ch);
  321.     if (Ch <> 'Q') and (Ch <> 'q') then
  322.     begin if (Ch = 'I') or (Ch = 'i') then Instructions
  323.       else begin if ((Ch = 'C') or (Ch = 'c')) and (L <> 0.0) and (Q > 1)
  324.               and (A * B * Y * Z <> 0.0) then begin clrscr;
  325.         GraphColorMode; Border; Hticks; Vticks; SpurHunt;
  326.         Hlabel; Hvariables; Vlabel; Vvariables; LOlabel; LOvariable;
  327.         Beep; read(kbd,Ch); TextMode end
  328.         else begin LowIF; HighIF; LowRF; HighRF; FixedLO; Order; end;
  329.       end;
  330.     end;
  331.   until (Ch = 'Q') or (Ch = 'q'); clrscr;
  332. END.
  333.  
  334.