{   originally written for HP85   by E. GREENWALD
    converted to Apple by C J Dockstader 12/15/84 last Rev 9/9/85
    converted to MS DOS  Turbo Pascal 3.02A  July 87 ....  C J D}

program SPURFREQ;
  const TDN = '8 12 PM July 23 1987';
  var Ch : char;
      LIF, HIF, LRF, HRF, FLO, TempS : string[10];
      A, B, L, P, R, X1, X2, Y, Y1, Y2, Y3, Y4, Y5, Y6, Z : real;
      Err, I, J, JJ, M, N, Q : integer;

procedure Zero;
  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); draw(I-2,J+5,I-2,J+1,1); end;

procedure One;
  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;

procedure Two;
  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);
    draw(I-2,J+6,I+2,J+6,1); end;

procedure Three;
  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
    +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;

procedure Four;
  begin draw(I+1,J,I+1,J+6,1); draw(I-2,J+4,I+2,J+4,1);
    draw(I-2,J+3,I+1,J,1); end;

procedure Five;
  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);
    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;

procedure Six;
  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);
    draw(I+2,J+5,I+2,J+4,1); draw(I+1,J+3,I-1,J+3,1); end;

procedure Seven;
  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;

procedure Eight;
  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);
    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);
    draw(I-1,J+3,I+1,J+3,1); end;

procedure Nine;
  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);
    draw(I+1,J+3,I-1,J+3,1); draw(I-2,J+2,I-2,J+1,1); end;

procedure DP;
  begin draw(I-1,J+4,I+1,J+4,1); plot(I-1,J+5,1); plot(I+1,J+5,1);
    draw(I-1,J+6,I+1,J+6,1); end;

procedure Equals;
  begin draw(I-1,J+2,I+1,J+2,1); draw(I-1,J+4,I+1,J+4,1); end;

procedure LetterF;
  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);
  end;

procedure LetterI;
  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);
  end;

procedure LetterL;
  begin draw(I-2,J,I-2,J+6,1); draw(I-1,J+6,I+2,J+6,1); end;

procedure LetterO;
  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);
    draw(I-1,J+6,I+1,J+6,1); end;

procedure LetterR;
  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);
    draw(I-1,J+3,I+1,J+3,1); draw(I,J+4,I+2,J+6,1); end;

procedure Beep; begin Sound(440); Delay(150); NoSound end;

procedure LowIF;
  begin gotoXY(43,5); read(TempS); writeln('      ');
    if TempS = '' then
    begin str(A:4:4,TempS); gotoXY(43,5); writeln(TempS,'      '); end
    else begin LIF := TempS; val(TempS,A,Err); str(A:4:4,TempS);
      gotoXY(43,5); writeln(TempS,'      '); end;
  end;

procedure HighIF;
  begin gotoXY(43,6); read(TempS); writeln('      ');
    if TempS = '' then
    begin str(B:4:4,TempS); gotoXY(43,6); writeln(TempS,'      '); end
    else begin HIF := TempS; val(TempS,B,Err); str(B:4:4,TempS);
      gotoXY(43,6); writeln(TempS,'      '); end;
  end;

procedure LowRF;
  begin gotoXY(43,7); read(TempS); writeln('      ');
    if TempS = '' then
    begin str(Y:4:4,TempS); gotoXY(43,7); writeln(TempS,'      '); end
    else begin LRF := TempS; val(TempS,Y,Err); str(Y:4:4,TempS);
      gotoXY(43,7); writeln(TempS,'      '); end;
  end;

procedure HighRF;
  begin gotoXY(43,8); read(TempS); writeln('      ');
    if TempS = '' then
    begin str(Z:4:4,TempS); gotoXY(43,8); writeln(TempS,'      '); end
    else begin HRF := TempS; val(TempS,Z,Err); str(Z:4:4,TempS);
      gotoXY(43,8); writeln(TempS,'      '); end;
  end;

procedure FixedLO;
  begin gotoXY(43,9); read(TempS); writeln('      ');
    if TempS = '' then
    begin str(L:4:4,TempS); gotoXY(43,9); writeln(TempS,'      '); end
    else begin FLO := TempS; val(TempS,L,Err); str(L:4:4,TempS);
      gotoXY(43,9); writeln(TempS,'      '); end;
  end;

procedure Order;
  begin gotoXY(43,10); read(TempS); writeln('      ');
    if TempS = '' then
    begin str(Q:4,TempS); gotoXY(43,10); writeln(TempS,'      '); end
    else val(TempS,Q,Err);
  end;


procedure Menu;
  begin clrscr; gotoXY(16,1);
    writeln('MIXER SPURIOUS FREQUENCY RESPONSES'); gotoXY(5,3);
    writeln('"I"nstructions   "E"nter data   "C"alculate   "Q"uit');
    str(A:4:4,TempS); gotoXY(15,5);
    writeln('  Low frequency end of I.F. ',TempS);
    str(B:4:4,TempS); gotoXY(15,6);
    writeln(' High frequency end of I.F. ',TempS);
    str(Y:4:4,TempS); gotoXY(15,7);
    writeln('  Low frequency end of R.F. ',TempS);
    str(Z:4:4,TempS); gotoXY(15,8);
    writeln(' High frequency end of R.F. ',TempS);
    str(L:4:4,TempS); gotoXY(15,9);
    writeln('  Fixed Local Oscillator    ',TempS);
    gotoXY(15,10); writeln('  Maximum order required    ',Q);
  end;

procedure Instructions;
  begin clrscr; gotoXY(16,1); writeln('MIXER SPURIOUS FREQUENCY RESPONSES');
    writeln; writeln('    Use a common frequency unit.'); writeln;
    writeln('    For the I.F. Low and High frequencies, use a bandpass that');
    writeln('         spurs are objectionable.'); writeln;
    write('    For the R.F. Low and High frequencies, do the same as for ');
    writeln('the I.F.'); writeln;
    writeln('    On the graph the left digit is the L.O. multiple.'); writeln;
    writeln('    The right digit is the R.F. multiple.');
    writeln; writeln; writeln;
    writeln(' originally written for HP85   by E. GREENWALD');
    writeln(' converted to Apple by C J Dockstader 12/15/84 last Rev 9/9/85');
    writeln(' converted to MS DOS   Turbo Pascal  July 87   C J D');
    writeln('Rev.   ',TDN,'   C J D'); read(kbd,Ch);
  end;

procedure Border;
  begin draw(0,0,319,0,2); draw(319,0,319,199,2);
    draw(319,199,0,199,2); draw(0,199,0,0,2);
  end;

procedure Hticks;
  begin Y1 := ln((Z-Y)/3)/ln(10);
    Y2 := exp(int(Y1)*ln(10))/2*exp(int((Y1-int(Y1))/0.34)*ln(2));
    Y3 := int(Y/Y2)*Y2; Y4 := 320*((int(Y/Y2)+1)*Y2-Y)/(Z-Y);
    while Y4 < 320 do
    begin Y5 := 0.0; while Y5 < 200 do
      begin draw(round(Y4),round(Y5),round(Y4),round(Y5+4),2); Y5:=Y5+195;
      end; Y4 := Y4 + 320*Y2/(Z-Y);
    end;
  end;

procedure Vticks;
  begin Y1 := ln((B-A)/3)/ln(10);
    Y2 := exp(int(Y1)*ln(10))/2*exp(int((Y1-int(Y1))/0.34)*ln(2));
    Y3 := int(A/Y2)*Y2; Y4 := 200-200*((int(A/Y2)+1)*Y2-A)/(B-A);
    while Y4 > 0 do
    begin Y5 := 0.0; while Y5 < 320 do
      begin draw(round(Y5),round(Y4),round(Y5+4),round(Y4),2); Y5:=Y5+315;
      end; Y4 := Y4 - 200*Y2/(B-A);
    end;
  end;

procedure Hlabel;
  begin I := 150; J:= 190; LetterR; I := 156; LetterF; end;

procedure Vlabel;
  begin I := 6; J := 97; LetterI; I := 12; LetterF; end;

procedure LOlabel;
  begin I := 268; J := 170; LetterL; I := 274; LetterO;
  I := 280; Equals; end;

procedure LabelValue;
  begin I := I + 6; if TempS = '0' then Zero;
     if TempS = '1' then One;   if TempS = '2' then Two;
     if TempS = '3' then Three; if TempS = '4' then Four;
     if TempS = '5' then Five;  if TempS = '6' then Six;
     if TempS = '7' then Seven; if TempS = '8' then Eight;
     if TempS = '9' then Nine;  if TempS = '.' then DP;
  end;

procedure Hvariables;
  begin  I := 12; J := 190; M := length(LRF);
    for N := 1 to M do begin TempS := copy(LRF,N,1); LabelValue; end;
    I := 280; J := 190; M := length(HRF);
    for N := 1 to M do begin TempS := copy(HRF,N,1); LabelValue; end;
  end;

procedure Vvariables;
  begin  I := 0; J := 5; M := length(HIF);
    for N := 1 to M do begin TempS := copy(HIF,N,1); LabelValue; end;
    I := 0; J := 180; M := length(LIF);
    for N := 1 to M do begin TempS := copy(LIF,N,1); LabelValue; end;
  end;

procedure LOvariable;
  begin  I := 280; J := 170; M := length(FLO);
    for N := 1 to M do begin TempS := copy(FLO,N,1); LabelValue; end;
  end;

procedure Sub1;  begin X1 := 319.0 * (A-P)/(R-P); end;

procedure Sub2;  begin X1 := 319.0 * (B-P)/(R-P); end;

procedure Sub3;  begin X2 := 319.0 * (B-P)/(R-P); end;

procedure Sub4;  begin X2 := 319.0 * (A-P)/(R-P); end;

procedure Sub5;  begin Y1 := 199.0 * (B-P)/(B-A); end;

procedure Sub6;  begin Y2 := 199.0 * (B-R)/(B-A); end;

procedure Interpolation;
  begin if P > R then
    begin
      if (P>B) and (A>=R) then begin Sub2; Y1 := 0.0; Sub4; Y2 := 199.0; end
        else if A>=R then begin X1 := 0.0; Sub5; Sub4; Y2 := 199.0; end
        else if P>B then begin Sub2; Y1 := 0.0; X2 := 319.0; Sub6; end
        else begin X1 := 0.0; Sub5; X2 := 319.0; Sub6; end;
    end else
    begin
      if (P<=A) and (R>B) then begin Sub1; Y1 := 199.0; Sub3; Y2 := 0.0; end
        else if A>=P then begin Sub1; Y1 := 199.0; X2 := 319.0; Sub6; end
        else if R>B then begin X1 := 0.0; Sub5; Sub3; Y2 := 0.0; end
        else begin X1 := 0.0; Sub5; X2 := 319.0; Sub6; end;
    end;
  end;

procedure OrderLabel;
  begin J := J + 8; JJ := J;
    if (Y1<1) and (Y2>198) then I := round((J+4)/200.0*(X2-X1)+X1)
    else begin if (Y1>198) and (Y2<1) then I := round((J+4)/200.0*(X1-X2)+X2)
    else begin JJ := JJ-8; I := round((X2-X1)/2+X1); J := round((Y2-Y1)/2+Y1);
         end; end; draw(I,J+3,I+8,J+3,1); I := I + 12;
    if M = 1 then One; if M = 2 then Two; if M = 3 then Three;
    if M = 4 then Four; if M = 5 then Five; if M = 6 then Six;
    if M = 7 then Seven; if M = 8 then Eight; if M = 9 then Nine;
    if M = 10 then begin One; I := I+6; Zero; end;
    if M = 11 then begin One; I := I+6; One; end;
    if M = 12 then begin One; I := I+6; Two; end;
    if M = 13 then begin One; I := I+6; Three; end;
    if M = 14 then begin One; I := I+6; Four; end;
    if M = 15 then begin One; I := I+6; Five; end;
    draw(I+4,J+3,I+6,J+3,1); I := I+10;
    if N = 1 then One; if N = 2 then Two; if N = 3 then Three;
    if N = 4 then Four; if N = 5 then Five; if N = 6 then Six;
    if N = 7 then Seven; if N = 8 then Eight; if N = 9 then Nine;
    if N = 10 then begin One; I := I+6; Zero; end;
    if N = 11 then begin One; I := I+6; One; end;
    if N = 12 then begin One; I := I+6; Two; end;
    if N = 13 then begin One; I := I+6; Three; end;
    if N = 14 then begin One; I := I+6; Four; end;
    if N = 15 then begin One; I := I+6; Five; end;
    if N = 16 then begin One; I := I+6; Six; end;
    if N = 17 then begin One; I := I+6; Seven; end; J := JJ;
  end;

procedure Graph1;
  begin Interpolation; draw(round(X1),round(Y1),round(X2),round(Y2),3);
    OrderLabel;
  end;

procedure Graph2;
  begin R:=-R; Interpolation; draw(round(X1),round(Y1),round(X2),round(Y2),3);
    OrderLabel; R:=-R; P:=-P; Interpolation;
    draw(round(X1),round(Y1),round(X2),round(Y2),3); OrderLabel;
  end;

procedure SpurHunt;
  begin J := 16; N := 1; for M := 1 to Q-N+1 do
    begin for N := 1 to Q-M do
      begin P := M*L+N*Y; R := M*L+N*Z;
        if (P>=A) and (P<=B) then Graph1
        else if (R>=A) and (R<=B) then Graph1
        else if (P<=A) and (R>=B) then Graph1;
        P := M*L-N*Y; R := M*L-N*Z;
        if ((P<0.0) and (R>0.0)) or ((P>0.0) and (R<0.0)) then
        begin P := abs(P); R := abs(R);
          if (P<A) and (A>R) then else Graph2;
        end else
        begin P := abs(P); R := abs(R);
          if (P>=A) and (P<=B) then Graph1
          else if (R>=A) and (R<=B) then Graph1
          else if (P<=A) and (R>=B) then Graph1
          else if (R<=A) and (P>=B) then Graph1;
        end;
      end;
    end;
  end;

procedure ZeroVar;
  begin A := 0.0; B := 0.0; Y := 0.0; Z := 0.0; L := 0.0; Q := 10; end;

BEGIN
  ZeroVar;
  repeat Menu; gotoXY(60,3); read(kbd,Ch);
    if (Ch <> 'Q') and (Ch <> 'q') then
    begin if (Ch = 'I') or (Ch = 'i') then Instructions
      else begin if ((Ch = 'C') or (Ch = 'c')) and (L <> 0.0) and (Q > 1)
              and (A * B * Y * Z <> 0.0) then begin clrscr;
        GraphColorMode; Border; Hticks; Vticks; SpurHunt;
        Hlabel; Hvariables; Vlabel; Vvariables; LOlabel; LOvariable;
        Beep; read(kbd,Ch); TextMode end
        else begin LowIF; HighIF; LowRF; HighRF; FixedLO; Order; end;
      end;
    end;
  until (Ch = 'Q') or (Ch = 'q'); clrscr;
END.