// Electronic Calculations - 12/27/2020 WTN
// Compile using: fpc -XX -Sx ecalcs.pas
// mostly copied from newton.freehostia.com/com2/isbas.htm
// License:
// Copyright 2020 by Terry Newton (WTN), All rights reserved.
// Permission is granted to use any part of this code for any purpose,
// with or without attribution, so long as such use does not infringe
// on my rights or the rights of others to do the same. This code is
// provided as-is and without warranty, use at your own risk.
program ecalcs;
uses sysutils,crt;
// enter a capacitor value, defaults to farads
// accepts u, uF, n, nF, p or pF (case insensitive)
// return 0 if enter or can't convert
function EnterC():double;
var multval:double;
var e:integer;
var ins:string;
begin
 multval:=1.0;
 readln(ins);
 ins:=trim(uppercase(ins));
 if rightstr(ins,1)='F' then
    ins:=leftstr(ins,length(ins)-1);
 case rightstr(ins,1) of
 'U': multval:=1.0E-6;
 'N': multval:=1.0E-9;
 'P': multval:=1.0E-12;
 end;
 if multval<0.9 then
    ins:=leftstr(ins,length(ins)-1);
 val(ins,EnterC,e);
 EnterC:=EnterC*multval;
 if e<>0 then EnterC:=0;
end;
// enter an inductance value, defaults to henries
// accepts m, mH, u, uH, n, nH 
// return 0 if enter or can't convert
function EnterL():double;
var multval:double;
var e:integer;
var ins:string;
begin
 multval:=1.0;
 readln(ins);
 ins:=trim(uppercase(ins));
 if rightstr(ins,1)='H' then
    ins:=leftstr(ins,length(ins)-1);
 case rightstr(ins,1) of
 'M': multval:=1.0E-3;
 'U': multval:=1.0E-6;
 'N': multval:=1.0E-9;
 end;
 if multval<0.9 then
    ins:=leftstr(ins,length(ins)-1);
 val(ins,EnterL,e);
 EnterL:=EnterL*multval;
 if e<>0 then EnterL:=0;
end;
// general number input for R F and V entries
// recognizes K for 1000, M for million, G for billion
// trailing V or H or HZ ignored if entered
// also accepts trailing m? u? (ms us mV uV etc) for milli and micro
// return 0 if enter or can't convert
function EnterN():double;
var e:integer;
var ins,tempstr:string;
var multval:double;
begin
 multval:=1.0;
 readln(ins); ins:=trim(uppercase(ins));
 tempstr:=rightstr(ins,2);
 case leftstr(tempstr,1) of
 'M': multval:=1.0E-3;
 'U': multval:=1.0E-6;
 end;
 if multval<0.9 then // remove MV/UV/MS/US now so won't mix up others
    ins:=leftstr(ins,length(ins)-2);
 if (rightstr(ins,1)='V') or (rightstr(ins,1)='H') then
    ins:=leftstr(ins,length(ins)-1); // ignore remaining trailing V or H
 if rightstr(ins,2)='HZ' then        // or HZ
    ins:=leftstr(ins,length(ins)-2);
 case rightstr(ins,1) of  // handle common multipliers
 'K': multval:=1.0E3;
 'M': multval:=1.0E6;
 'G': multval:=1.0E9;
 end;
 if multval>1.1 then // remove suffix
    ins:=leftstr(ins,length(ins)-1);
 val(ins,EnterN,e);
 EnterN:=EnterN*multval;
 if e<>0 then EnterN:=0.0;
end;
// remove trailing zeros and leading spaces
function tztrim(s:string):string;
var p:integer;
begin
 s:=trim(s); tztrim:=s; // remove leading spaces
 p:=pos('E',s); if p>0 then exit; //don't convert exp notation
 p:=pos('.',s);
 if p>0 then begin
  repeat
   if rightstr(tztrim,1)='0' then
      tztrim:=leftstr(tztrim,length(tztrim)-1);
  until rightstr(tztrim,1)<>'0';
 end;
 if rightstr(tztrim,1)='.' then
    tztrim:=leftstr(tztrim,length(tztrim)-1);
end;
// return trimmed number string 
function Nstring(n:double):string;
begin
 str(n,Nstring); // default to plain conversion
 if (n>-1.0E9) and (n<1.0E9) then begin
  if (n>=0.01) or (n<=-0.01) then begin
   str(n:9:6,Nstring); Nstring:=tztrim(Nstring);
  end else begin
   if (n>=1.0E-6) or (n<=-1.0E-6) then
      str(n:1:10,Nstring); Nstring:=tztrim(Nstring);
  end;
 end;
end;
// return string with R value
function Rstring(R:double):string;
begin
 Rstring:='error';
 if R<0.0 then exit;
 if R<1.0E3 then begin
  str(R:6:6,Rstring);
  Rstring:=tztrim(Rstring)+' ohms';
 end else begin
  if R<1.0E6 then begin
   R:=R/1.0E3;
   str(R:6:6,Rstring);
   Rstring:=tztrim(Rstring)+'K';
  end else begin
   R:=R/1.0E6;
   str(R:9:6,Rstring);
   Rstring:=tztrim(Rstring)+'M';
  end;
 end;
end;
// return string with C value
function Cstring(C:double):string;
begin
 Cstring:='error';
 if C<0.0 then exit;
 if C<1.0E-9 then begin
  C:=C*1.0E12;
  str(C:6:6,Cstring);
  Cstring:=tztrim(Cstring)+'pF';
 end else begin
  if C<1.0E-1 then begin
   C:=C*1.0E6;
   str(C:6:6,Cstring);
   Cstring:=tztrim(Cstring)+'uF';
  end else begin
   str(C:9:6,Cstring);
   Cstring:=tztrim(Cstring)+'F';
  end;
 end;
end;
// return string with L value
function Lstring(L:double):string;
begin
 Lstring:='error';
 if L<0.0 then exit;
 if L<1.0E-6 then begin
  L:=L*1.0E9;
  str(L:6:6,Lstring);
  Lstring:=tztrim(Lstring)+'nH';
 end else begin
  if L<1.0E-3 then begin
   L:=L*1.0E6;
   str(L:6:6,Lstring);
   Lstring:=tztrim(Lstring)+'uH';
  end else begin
   if L<1.0 then begin
    L:=L*1000.0;
    str(L:6:6,Lstring);
    Lstring:=tztrim(Lstring)+'mH';
   end else begin
    str(L:9:6,Lstring);
    Lstring:=tztrim(Lstring)+'H';
   end;
  end;
 end;
end;
// return string with frequency value
function Fstring(F:double):string;
begin
 Fstring:='error';
 if F<0.0 then exit;
 str(F,Fstring); //default convert
 if (F>=0.001) and (F<1.0E15) then begin //only convert sensible values
  if F<1.0E4 then begin
   str(F:6:6,Fstring);
   Fstring:=tztrim(Fstring)+' hertz';
  end else begin
   if F<1.0E6 then begin
    F:=F/1000.0;
    str(F:6:6,Fstring);
    Fstring:=tztrim(Fstring)+' Khz';
   end else begin
    if F<1.0E9 then begin
     F:=F/1.0E6;
     str(F:6:6,Fstring);
     Fstring:=tztrim(Fstring)+' Mhz';
    end else begin
     F:=F/1.0E9;
     str(F:9:6,Fstring);
     Fstring:=tztrim(Fstring)+' Ghz';
    end;
   end;
  end;
 end;
end;
// voltage to db
function VtoDB(V:double):double;
begin VtoDB:=(ln(V)/ln(10.0))*20.0; end;
// voltage divider calculation
procedure GainCalcs;
var Gain,R1,R2:double;
var sel:char;
begin
 writeln('----- Voltage divider/gain calculations -----');
 writeln('1) Voltage divider gain (attenuation)');
 writeln('2) Non-inverting opamp gain');
 writeln('3) Inverting opamp / ratio gain');
 write('Which one? '); sel:=readkey;
 case sel of
 '1':begin writeln(sel);
   write('Enter top R    : '); R1:=EnterN; if R1<=0 then exit;
   write('Enter bottom R : '); R2:=EnterN; if R2<=0 then exit;
   Gain:=R2/(R1+R2);
  end;
 '2':begin writeln(sel);
   write('Enter R from out to inv-in : '); R1:=EnterN; if R1<=0 then exit;
   write('Enter R from inv-in to gnd : '); R2:=EnterN; if R2<=0 then exit;
   Gain:=1.0+(R1/R2);
  end;
 '3':begin writeln(sel);
   write('Enter input R or V  : '); R1:=EnterN; if R1<=0 then exit;
   write('Enter output R or V : '); R2:=EnterN; if R2<=0 then exit;
   Gain:=R2/R1;
  end;
 else begin writeln; exit; end;
 end;
 writeln('Voltage Gain = ',Nstring(Gain),' (',Nstring(VtoDB(Gain)),'dB)');
end;
// series C
procedure SeriesC;
var C,Cacc:double;
begin
 writeln('----- Series capacitors -----');
 writeln('Enter all C values then press enter to calculate');
 Cacc:=0.0;
 repeat
  write('Enter C: '); C:=EnterC;
  if C<>0.0 then Cacc:=Cacc+(1.0/C);
 until C<=0.0;
 gotoxy(1,wherey-1);clreol; // cursor up to column 1 and erase line
 if Cacc<=0.0 then exit;
 writeln('Total series C = ',Cstring(1.0/Cacc));
end;
// parallel R
procedure ParallelR;
var R,Racc:double;
begin
 writeln('----- Parallel resistors -----');
 writeln('Enter all R values then press enter to calculate');
 Racc:=0.0;
 repeat
  write('Enter R: '); R:=EnterN;
  if R<>0.0 then Racc:=Racc+(1.0/R);
 until R<=0.0;
 gotoxy(1,wherey-1);clreol;
 if Racc<=0.0 then exit;
 writeln('Total parallel R = ',Rstring(1.0/Racc));
end;
// needed R
procedure NeededR;
var Rexisting,Rdesired,Rneeded:double;
begin
 writeln('----- Calculate needed parallel resistor -----');
 write('Existing R : '); Rexisting:=EnterN; if Rexisting<=0 then exit;
 write('Desired R  : '); Rdesired:=EnterN;  if Rdesired<=0 then exit;
 if Rdesired >= Rexisting then begin
  writeln('Desired must be less than existing'); exit;
 end;
 Rneeded:=1.0/((1.0/Rdesired)-(1.0/Rexisting));
 writeln('Needed R = ',Rstring(Rneeded));
end;
// capacitive reactance
procedure CapZ;
var sel:char;
var C,F,Z:double;
begin
 writeln('----- Capacitive reactance -----');
 writeln('1) Calculate Z from C and F');
 writeln('2) Calculate C from Z and F');
 writeln('3) Calculate F from Z and C');
 write('Which one? '); sel:=readkey;
 case sel of
 '1':begin writeln(sel);
   write('Enter C: '); C:=EnterC; if C<=0 then exit;
   write('Enter F: '); F:=EnterN; if F<=0 then exit;
   Z:=1.0/(6.28318530718*C*F);
   writeln('Z = ',Rstring(Z));
  end;
 '2':begin writeln(sel);
   write('Enter Z: '); Z:=EnterN; if Z<=0 then exit;
   write('Enter F: '); F:=EnterN; if F<=0 then exit;
   C:=1.0/(6.28318530718*Z*F);
   writeln('C = ',Cstring(C));
  end;
 '3':begin writeln(sel);
   write('Enter Z: '); Z:=EnterN; if Z<=0 then exit;
   write('Enter C: '); C:=EnterC; if C<=0 then exit;
   F:=1.0/(6.28318530718*Z*C);
   writeln('F = ',Fstring(F));
  end;
 else writeln;
 end;
end;
// inductive reactance
procedure IndZ;
var sel:char;
var L,F,Z:double;
begin
 writeln('----- Inductive reactance -----');
 writeln('1) Calculate Z from L and F');
 writeln('2) Calculate L from Z and F');
 writeln('3) Calculate F from Z and L');
 write('Which one? '); sel:=readkey;
 case sel of
 '1':begin writeln(sel);
   write('Enter L: '); L:=EnterL; if L<=0 then exit;
   write('Enter F: '); F:=EnterN; if F<=0 then exit;
   Z:=6.28318530718*L*F;
   writeln('Z = ',Rstring(Z));
  end;
 '2':begin writeln(sel);
   write('Enter Z: '); Z:=EnterN; if Z<=0 then exit;
   write('Enter F: '); F:=EnterN; if F<=0 then exit;
   L:=Z/(6.28318530718*F);
   writeln('L = ',Lstring(L));
  end;
 '3':begin writeln(sel);
   write('Enter Z: '); Z:=EnterN; if Z<=0 then exit;
   write('Enter L: '); L:=EnterL; if L<=0 then exit;
   F:=Z/(6.28318530718*L);
   writeln('F = ',Fstring(F));
  end;
 else writeln;
 end;
end;
// LC resonant frequency
procedure Resonance;
var sel:char;
var L,F,C:double;
begin
 writeln('----- LC Resonance -----');
 writeln('1) Calculate F from L and C');
 writeln('2) Calculate L from F and C');
 writeln('3) Calculate C from F and L');
 write('Which one? '); sel:=readkey;
 case sel of
 '1':begin writeln(sel);
   write('Enter L: '); L:=EnterL; if L<=0 then exit;
   write('Enter C: '); C:=EnterC; if C<=0 then exit;
   F:=1.0/(6.28318530718*sqrt(L*C));
   writeln('F = ',Fstring(F));
  end;
 '2':begin writeln(sel);
   write('Enter F: '); F:=EnterN; if F<=0 then exit;
   write('Enter C: '); C:=EnterC; if C<=0 then exit;
   L:=25330.3/(F*F*C); //in uH
   L:=L/1000000.0; //convert to H
   writeln('L = ',Lstring(L));
  end;
 '3':begin writeln(sel);
   write('Enter F: '); F:=EnterN; if F<=0 then exit;
   write('Enter L: '); L:=EnterL; if L<=0 then exit;
   C:=25330.3/(F*F*L); //in uF
   C:=C/1000000.0; //convert to F
   writeln('C = ',Cstring(C));
  end;
 else writeln;
 end;
end;
// resistance noise
procedure Rnoise;
var R,T,F,N:double;
var tempstr:string;
var conv,e:integer;
begin
 writeln('----- Calculate noise voltage -----');
 write('Enter resistance: '); R:=EnterN; if R<=0 then exit;
 write('Enter temp in K (or add C or F): '); readln(tempstr);
 tempstr:=trim(uppercase(tempstr)); if tempstr='' then exit;
 conv:=0; // defalt K
 case rightstr(tempstr,1) of
 'K': conv:=1;
 'C': conv:=2;
 'F': conv:=3;
 end;
 if conv>0 then
    tempstr:=leftstr(tempstr,length(tempstr)-1); // remove suffix
 val(tempstr,T,e); if e<>0 then exit;
 if conv=2 then T:=T+273.15; // convert C to K
 if conv=3 then T:=((T-32.0)*(5.0/9.0))+273.15; // convert F to K
 if T<=0 then
    begin writeln('Can''t be at or below absolute zero'); exit; end;
 write('Enter bandwidth (20K for audio): '); F:=EnterN; if F<=0 then exit;
 N:=sqrt(4.0*1.38065E-23*T*F*R);
 if N<0.001 then
    writeln('Noise = ',Nstring(N*1.0E6),' microvolts (uV)')
 else if N<1.0 then
         writeln('Noise = ',Nstring(N*1.0E3),' millivolts (mV)')
      else writeln('Noise = ',Nstring(N),' volts'); 
end;
// capacitor charge calculations
// similar to http://www.bowdenshobbycircuits.info/rc.htm
// common entry functions
function GetVs():double; begin
 write('Enter Vs: '); GetVs:=EnterN; end;
function GetVc():double; begin
 write('Enter Vc: '); GetVc:=EnterN; end;
function GetT():double; begin
 write('Enter T : '); GetT:=EnterN; end;
function GetR():double; begin
 write('Enter R : '); GetR:=EnterN; end;
function GetC():double; begin
 write('Enter C : '); GetC:=EnterC; end;
// main capcharge procedure
procedure CapCharge;
var Vs,Vc,T,R,C:double;
var sel:char;
begin
 writeln('----- Capacitor charge calculations -----');
 writeln('Vs = Absolute supply voltage');
 writeln('Vc = Absolute capacitor voltage');
 writeln('T = Time (default seconds unless ms or us appended)');
 writeln('R = Series resistance (default ohms unless K or M)');
 writeln('C = Capacitance (default F unless u n or p)');
 writeln('1) Calculate T from Vs Vc R C');
 writeln('2) Calculate R from Vs Vc T C');
 writeln('3) Calculate C from Vs Vc T R');
 writeln('4) Calculate Vc from Vs T R C');
 writeln('5) Calculate Vs from Vc T R C');
 write('Which one? '); sel:=readkey;
 case sel of
 '1':begin writeln(sel);
   Vs:=GetVs; if Vs<=0 then exit;
   Vc:=GetVc; if Vc<=0 then exit;
   if Vc>=Vs then begin
    writeln('Vs must be greater than Vc'); exit;
   end;
   R:=GetR;   if R<=0 then exit;
   C:=GetC;   if C<=0 then exit;
   T:=-ln((Vs-Vc)/Vs)*R*C;
   if T<0.001 then begin
    writeln('T = ',Nstring(T*1.0E6),' microseconds (us)');
   end else begin
    if T<0.1 then begin
     writeln('T = ',Nstring(T*1.0E3),' milliseconds (ms)');
    end else begin
     writeln('T = ',Nstring(T),' seconds');
    end;
   end;
  end;
 '2':begin writeln(sel);
   Vs:=GetVs; if Vs<=0 then exit;
   Vc:=GetVc; if Vc<=0 then exit;
   if Vc>=Vs then begin
    writeln('Vs must be greater than Vc'); exit;
   end;
   T:=GetT;   if T<=0 then exit;
   C:=GetC;   if C<=0 then exit;
   R:=-T/(ln((Vs-Vc)/Vs)*C);
   writeln('R = ',Rstring(R));
  end;
 '3':begin writeln(sel);
   Vs:=GetVs; if Vs<=0 then exit;
   Vc:=GetVc; if Vc<=0 then exit;
   if Vc>=Vs then begin
    writeln('Vs must be greater than Vc'); exit;
   end;
   T:=GetT;   if T<=0 then exit;
   R:=GetR;   if R<=0 then exit;
   C:=-T/(ln((VS-VC)/VS)*R);
   writeln('C = ',Cstring(C));
  end;
 '4':begin writeln(sel);
   Vs:=GetVs; if Vs<=0 then exit;
   T:=GetT;   if T<=0 then exit;
   R:=GetR;   if R<=0 then exit;
   C:=GetC;   if C<=0 then exit;
   Vc:=Vs-(Vs*exp(-T/(R*C)));
   writeln('Vc = ',Nstring(Vc));
  end;
 '5':begin writeln(sel);
   Vc:=GetVc; if Vc<=0 then exit;
   T:=GetT;   if T<=0 then exit;
   R:=GetR;   if R<=0 then exit;
   C:=GetC;   if C<=0 then exit;
   Vs:=-Vc/(exp(-(1.0/(R*C))*T)-1.0);
   writeln('Vs = ',Nstring(Vs));
  end;
 else writeln;
 end;
end;
// main menu
var inputkey:char;
var exitprog,showmenu:integer;
begin
 exitprog:=0; showmenu:=1;
 writeln('ECALCS - Electronics Calculations - version 201227 by WTN');
 writeln('---------------------------------------------------------');
 writeln('At the Select prompt Enter to redisplay menu, Esc to exit');
 writeln('C entries accept uF nF and pF divisors (trailing F is ignored)');
 writeln('L entries accept mH uH and nH divisors (trailing H is ignored)');
 writeln('Other entries accept K M G multipliers (trailing V hz ignored)');
 writeln('and also accept ms mV mO us uV uO etc for milli and micro');
 writeln('---------------------------------------------------------');
 repeat
  if showmenu=1 then begin
   writeln(#13'1) Voltage divider/gain'); // start at col 1 if redisplayed
   writeln('2) Series capacitors');
   writeln('3) Parallel resistors');
   writeln('4) Needed parallel resistor');
   writeln('5) Capacitive reactance');
   writeln('6) Inductive reactance');
   writeln('7) Resonant frequency');
   writeln('8) Resistance noise');
   writeln('9) Capacitor charge');
  end;
  write(#13'Select:'); inputkey:=readkey; // cr ensures it starts at col 1
  if (inputkey>='1') and (inputkey<='9') then begin // valid selection
   showmenu:=0;       // don't redisplay menu unless requested
   writeln(inputkey); // print the selection
  end;
  try // inputs are checked but some entries can still cause errors
   case inputkey of
   '1': GainCalcs;
   '2': SeriesC;
   '3': ParallelR;
   '4': NeededR;
   '5': CapZ;
   '6': IndZ;
   '7': Resonance;
   '8': Rnoise;
   '9': CapCharge;
   #13: showmenu:=showmenu+1; //increment to reject multiple enters
   #27: exitprog:=1;
   else
    if showmenu=1 then showmenu:=2; // avoid redisplaying menu
   end;
  except // error handling...
   on E:Exception do begin
    writeln;writeln('An error occured...');
    writeln(E.Message);writeln;
    showmenu:=1;
   end;
  end;
 until exitprog<>0;
 writeln;
end.