home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 1
/
HamRadio.cdr
/
tech
/
design3
/
spurfreq.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-07-23
|
13KB
|
334 lines
{ 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.